自動轉換 層，顏色，線型

BILL.PU

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

, d7 r# j0 e/ o謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
" ?. X8 z8 W' K. Y! f
& `3 m. Y0 i2 z7 o7 _6 I! [$ d. 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
: m9 r' a) [/ O) W感謝樓上回復,不知哪裡可下載

不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
2 L+ ]+ B* h" X7 {/ x

BILL.PU

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

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   5 _# d) N* C# w/ U
3.     Dim E As AcadEntity
   % z% Z, Q+ b1 G2 T* w- Z7 w
4.     ThisDrawing.Layers.Add "AA"
   
5.     LoadLineType "HIDDEN"
   4 Y; i* _. k: M, c
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   1 \4 U( y$ p) ?
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    $ }! @* W* X2 `% v
12.             Case "窄部可见(ISO)"
    0 Q, H% V! P$ v( n' x7 l5 F& h
13.                 E.color = 5
    - y8 Q3 F( z1 X' W" X& y
14.                 E.Linetype = "Continuous"
    % V6 d' P4 {  p4 h9 [4 U
15.             Case "隐藏(ISO)"
    3 e9 t0 T: X" u/ A( t
16.                 E.color = 4
    
17.                 E.Linetype = "HIDDEN"
    9 B0 k; a- z0 C0 e% x# s1 R) h4 @$ J9 |
18.             Case "中心线(ISO)", "中心标记(ISO)"
    1 M: Y3 ]+ a/ m0 R) A3 H
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    
24. End Sub
    
25. 
    2 T: H" m8 k) C2 \  q+ _1 K
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    + }7 m' s* B/ D* r1 i% ]
28.     For Each T In ThisDrawing.Linetypes
    + L' X' U2 _: ]6 c  v
29.         If T.Name = S Then
    ' b( q- M: @& y* ~
30.             B = True
    & ?& X' \; R, p% }
31.             Exit For
    
32.         End If
    
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    + `$ i+ J8 C+ p/ A  l

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
6 I% j, L0 U4 |" o' A* j    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
  (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")
       (command "change" ee """p" "la" "xuxian" "")
% R, z3 V2 M2 ]' e      )
8 C9 X' r& f! o6 R7 |. {    (setq i (+ i 1))
   )
7 D+ G& }6 q: s5 `4 l  \* [)
  
用上面的方法可去把不同的线型分出去。