自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
, l6 z1 B! a) K; v' E2 h如下圖

謝謝

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
感謝樓上回復,不知哪裡可下載

4 A. n' A% ^5 _/ Y" T不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。

BILL.PU

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

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   
3.     Dim E As AcadEntity
   # V4 J# U1 L* Q) U* h) K, _
4.     ThisDrawing.Layers.Add "AA"
   $ r0 H2 D2 }7 w5 o5 `( L# w' }
5.     LoadLineType "HIDDEN"
   $ [, e" ^3 q  q; H& ]' c; ?
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   ' n- T& I6 F/ r7 T2 k* Q+ r
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   2 o& c# E) `- n# u& C
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    : w+ s- i" n& H% z3 Q( i
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    ' K4 d5 c3 l. Z4 e
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    , m! f/ o2 X( W' I0 k
21.         End Select
    
22.         E.Layer = "AA"
    - ?, i7 R( O9 P* n/ Y/ Y
23.     Next
    - G. A9 p  F" P4 P& ]
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
    $ C2 x3 C1 F0 g; w8 ?5 C" P
29.         If T.Name = S Then
    # j* Q; a6 L1 g4 {, R) b, N3 e
30.             B = True
    1 ]3 y& o% T) p, W* @6 b' O
31.             Exit For
    1 h" |8 |3 j# E" b( Z
32.         End If
    
33.     Next
    . }" A3 ]% m/ g* b% x
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    ; b. H/ B2 g6 d
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
3 D5 @& U# P2 n0 Z(if (not (tblsearch "layer" "xuxian"))
0 F  Q: {7 e! \/ Y' _    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
; D/ O' u# i; ?* W5 Y: \8 R& F    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
4 I2 S4 P$ K; q9 }6 g% Y                           ;;;你是在同一层上画了不同的线型
(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
3 F6 h0 f! h2 v- n; K    (if (= linee "HIDDEN")
! ~) S( n, u, R* q       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
6 t. o% {( O) j0 l* a, `# K, Y   )
)
  
用上面的方法可去把不同的线型分出去。