自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
+ [% n, W6 n# C; v4 L  h求助,自動轉換 層，顏色，線型 .LSP
# J3 c( y8 S' n% {0 \如下圖

謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
6 I; {# w) d2 [) L0 _8 T( G
0 V" T6 |% t0 y[ 本帖最后由 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
感謝樓上回復,不知哪裡可下載

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

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
, }; O9 L, Y* ?5 F1 @" w7 o/ i所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   ( `3 \# O% V8 i3 D4 v7 v' D% @
3.     Dim E As AcadEntity
   2 x2 F( o7 R: m0 [
4.     ThisDrawing.Layers.Add "AA"
   ! {% E( S8 r7 x6 W! N
5.     LoadLineType "HIDDEN"
   7 f( u7 A' n8 y' ]8 O
6.     LoadLineType "CENTER"
   - F/ K9 h7 n8 D
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
     D- Y# M' d/ r8 |
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    + G# F! }4 k+ k9 I9 \, ^! Z
11.                 E.Linetype = "Continuous"
    ! |2 x6 _" B! d( `& i
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    % k) ], k" L1 ?: g$ i
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    # c1 F3 M5 Z3 y+ r: T, V5 e! ^7 s
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    . \9 ]: J- a2 }6 t. a. U
24. End Sub
    ; F) Q8 N$ }( Q+ h$ ~) A, c
25. 
    9 D+ [9 ?5 [- s) G" y
26. Private Sub LoadLineType(S As String)
    ) _4 c9 A/ W  }" k' \3 y8 J
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    
29.         If T.Name = S Then
    
30.             B = True
    2 N: D% \1 Y- _: [2 @5 H5 O( K
31.             Exit For
    
32.         End If
    
33.     Next
    / d2 v& G4 W9 r9 M. W
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    ' ~/ v7 Q4 t3 [; T; l
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
, D6 ^  k* ?& h% R                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
5 m2 |( @5 ~- {; m. y* g* x( s  (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" "")
      )
    (setq i (+ i 1))
   )
1 q+ x* Y9 `+ |* y' d)
& t. T0 a4 A, e+ R7 ~1 @! N, _  
' M0 l- c- I$ A, F用上面的方法可去把不同的线型分出去。