自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
如下圖
+ e' F3 r0 K) f' ^1 \4 V
謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
1 {3 b: O: O' C, s( o' i
[ 本帖最后由 sealive_leafage 于 2009-12-10 19:34 编辑 ]

BILL.PU

感謝樓上回復,不知哪裡可下載

rongjian

原帖由 BILL.PU 于 2009-12-10 20:47 发表 http://www.3dportal.cn/discuz/images/common/back.gif
7 L2 x4 D& J, ?, K( X5 Q6 K: q感謝樓上回復,不知哪裡可下載

  u7 Z  w: w3 }) Q( s不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
, F5 }  N. @1 U7 J8 O

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
9 n. X" |- M* E) ^所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   2 l# k! T* J* }: M1 b
2. Sub A()
   
3.     Dim E As AcadEntity
   2 T8 i, I" s4 h# N, b
4.     ThisDrawing.Layers.Add "AA"
     @! ?/ R- \( I8 X' e5 i5 {( s
5.     LoadLineType "HIDDEN"
   9 m" Y$ [- N% m
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   % K# o: }5 S8 L  Q
9.             Case "可见(ISO)"
   1 t" ~( Y' O8 D
10.                 E.color = 7
    1 o. @  N! I& M6 x! Q+ t8 O, f
11.                 E.Linetype = "Continuous"
    ) I$ @) z$ m6 a" T5 M% G8 v+ q
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    - ^# \4 y1 W; J  ?$ ]# b# ?* c/ q
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    % ^5 W# Q, _  l. F$ a; f$ b! y( k
16.                 E.color = 4
    + w% s; B9 `0 p% s, p- E
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
    ( {0 b' V( Y- I1 F
20.                 E.Linetype = "CENTER"
    6 c% W- S4 l# s. Y" o2 I) P, l8 y
21.         End Select
    : L- @/ Q( T% C7 J; S, _* `% m
22.         E.Layer = "AA"
    
23.     Next
    
24. End Sub
    $ L3 j8 Q: u) [
25. 
    
26. Private Sub LoadLineType(S As String)
    # {( x/ o, T6 y) o
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    + W5 W: W/ N3 `7 e
29.         If T.Name = S Then
    
30.             B = True
    , Y1 ?, Z# Y! y% A
31.             Exit For
    ' d7 h$ ]% L8 r
32.         End If
    
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
' q( z: q+ W, u4 H(defun c:chgla ()
- k& D$ w  k2 s4 g% J+ Z+ V  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
    (if (= linee "HIDDEN")
: v  a9 g* C8 u7 [! x       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
   )
)
6 ~- ~$ E4 s# d  
用上面的方法可去把不同的线型分出去。