自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
4 @0 r/ q! l: `, c+ ?1 N2 k1 B如下圖

) |$ b* j: G( I謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
/ V& D& o$ [& L  M+ m. X3 x
, `, w' |; C8 `* k4 B' B[ 本帖最后由 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
) B8 `' V0 B8 z% \/ \5 Z. @! k感謝樓上回復,不知哪裡可下載

- y) ^2 O1 e/ O: L) f: R不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
  T" J) O+ g1 M9 y/ q4 G1 T

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   1 F5 D( o  D6 T/ J. V5 a
2. Sub A()
   . h. Z; ^( P$ h" U4 T" N
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   , G) V. m, V/ G6 D
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   1 h" T% {" c& v% [0 d! L
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   / o2 b8 F" k& t" Z5 u
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    2 V: Z* {, b9 h; K. Q, M( O
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    $ B" i  E& Q! v
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    3 `4 S1 k( z9 \
16.                 E.color = 4
    
17.                 E.Linetype = "HIDDEN"
    , j  i* v4 S% M! g
18.             Case "中心线(ISO)", "中心标记(ISO)"
    2 s: g. Z$ [1 Z$ h) f  W8 ^# H7 ]9 L6 d9 O
19.                 E.color = 1
    5 B# g) @! s& b5 ]9 W% E# H; U
20.                 E.Linetype = "CENTER"
    ) H: p, @+ G0 w/ {& p
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    5 S# l9 C6 F8 P- K, c7 p
24. End Sub
    
25. 
    / _3 c+ P( G* o8 R2 v: J% |
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    3 a/ v! M; y$ C" j
28.     For Each T In ThisDrawing.Linetypes
    
29.         If T.Name = S Then
    5 q, C; @6 Q4 g) F. g' K
30.             B = True
    
31.             Exit For
    
32.         End If
    , _7 L# f# S' e! b9 N( R& d
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
      }3 p6 x8 I1 p4 u5 s
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
+ G3 j& Y3 T$ @8 o5 _2 ~" L4 d+ G    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
4 g+ t  ^$ x9 R5 A$ v$ B( k                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
+ q; K" x/ _8 c% d* {6 @8 y4 D( p  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
6 E/ K1 @; `, v* b6 C! D; N    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
  I+ A0 T& |- E    (if (= linee "HIDDEN")
       (command "change" ee """p" "la" "xuxian" "")
/ X# p4 s) Y# C3 Z% C/ k% ]+ m  o      )
    (setq i (+ i 1))
+ M3 a4 y0 I2 |" {   )
)
  
7 V8 Z8 T+ K' j. `8 b用上面的方法可去把不同的线型分出去。