自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
如下圖

謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；

[ 本帖最后由 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
8 u) B+ N1 c. O% N感謝樓上回復,不知哪裡可下載

不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
, @' A6 f" {" r) V6 \

BILL.PU

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

woaishuijia

VBA代码,供参考

1. 
   5 U  u( R3 T" D: z
2. Sub A()
   5 [; I7 r* }& C0 ]; Z$ y
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   3 D1 O! H9 J* K
5.     LoadLineType "HIDDEN"
   # V: R+ t3 ?! n  ?6 n
6.     LoadLineType "CENTER"
   ; N5 B& d$ }2 H" @9 l1 \
7.     For Each E In ThisDrawing.ModelSpace
   3 J& ^: j' R4 j5 d) l" k. U% s
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   7 u, ]8 k* T8 m
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    2 v: l* ?2 H- Q8 s
13.                 E.color = 5
    
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    . s  Y( D2 Q  ]. J4 P" |' o$ k3 l" m
16.                 E.color = 4
    + |. S0 W8 h% x" n1 f: H
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
      J) h- h( T; Y. S1 N3 G
20.                 E.Linetype = "CENTER"
    - ~/ w. U6 U1 e( L
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    ; g/ U" t. n* J# z, ?2 w8 P( g$ `2 F
24. End Sub
    
25. 
    4 [1 j; c- y: O, T) H6 z: L( N
26. Private Sub LoadLineType(S As String)
    # n* C% F3 z1 Z5 e+ Y# p. o
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    
29.         If T.Name = S Then
    
30.             B = True
    / S5 S0 r% ]5 I' J
31.             Exit For
    1 F) E/ q; `2 _- v: }! s7 a% R
32.         End If
    
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    # [0 x4 G0 _- o7 l/ g0 D2 z- M
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
" v! i8 [2 L8 q* |7 q7 R(if (not (tblsearch "layer" "xuxian"))
+ }; Z/ s8 q6 ?$ i    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
1 w1 L7 l2 T& X' E' _; M. p9 m6 B    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
. ^8 ~2 z1 W$ Z' N                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
0 y/ E  C& ~( K  (setq en (ssget "all") n (sslength en) i 0)
' j0 i+ I( @3 _- `5 f( b7 \  (repeat n
5 P& N1 z( e0 l' I    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
) c1 p' W6 C$ J5 ?  j1 h    (if (= linee "HIDDEN")
       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
; J" }! o9 d6 S+ _3 p   )
: ^' B+ M6 f( {6 c  ^8 u)
. l6 y/ }+ D; d$ d  
用上面的方法可去把不同的线型分出去。