自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
8 N2 q! y* R/ D' L1 r" p. q$ n/ x如下圖

謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
- @4 V  y( R4 D& f3 T! G, [
[ 本帖最后由 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
' r) T% `! _* K  k; I4 r9 F+ v感謝樓上回復,不知哪裡可下載

不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
7 s2 X& i5 q+ |

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
2 I7 N: ?$ L+ ?) M. @所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   4 I0 x3 e& _# R( N3 h
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   1 m1 e$ y/ E; _; D* g
10.                 E.color = 7
    ' U2 W8 K- ^4 D2 u1 U
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    
14.                 E.Linetype = "Continuous"
    $ y! h& ?8 o  ]4 b7 B
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    & p0 T( y5 C! P5 S% x) r8 e
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    # t+ I3 P6 l; Y! k
19.                 E.color = 1
    3 O  l( K# U! N$ Q. n9 Z; p
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    / m6 M- u3 x  `* Q
24. End Sub
    
25. 
    
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    
29.         If T.Name = S Then
    + h! w) B7 B9 o; C* h* m/ i- ~
30.             B = True
    5 d. _1 x9 w1 f( I& k" Y$ X8 c! C' S
31.             Exit For
    
32.         End If
    
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    $ t8 G3 J8 F4 B0 q1 f

复制代码

哥哥很善良

用下面的程序:
6 e5 [' U) z) @. i0 ](if (not (tblsearch "layer" "xuxian"))
' F2 W- O( |. T8 G; }    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
" K* u& E  h7 S' U( k3 o2 ^$ d                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
4 ~: I- l( T, D, ?  S% e5 H    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
( u, f, }+ W5 Z  i3 B8 G% F( Z; p) u    (if (= linee "HIDDEN")
3 P7 [* m7 I# I; n2 [+ O# b       (command "change" ee """p" "la" "xuxian" "")
) Q+ l2 C9 R! z  b      )
9 C+ {  c7 e6 J& z5 Y! Y& p$ P: N    (setq i (+ i 1))
   )
)
  
) S3 C, I' o" T2 [用上面的方法可去把不同的线型分出去。