自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
5 [$ a8 l/ Z- R7 ^4 ]求助,自動轉換 層，顏色，線型 .LSP
$ \' |3 D1 R& v, w) r9 D/ p如下圖

4 i0 r1 V, S! A謝謝

登录/注册后可看大图

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

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

登录/注册后可看大图

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
- u) b- l' E/ p' T- J所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   + ^( c- l, i3 r, h* A$ ?7 W
2. Sub A()
   
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   ' x8 \, r  z* \# T8 g+ V
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   4 L9 t, t: s& g: a0 i
9.             Case "可见(ISO)"
   $ c3 J% f  m/ T! n
10.                 E.color = 7
    0 u. ^( }8 }6 `- Z% D2 L
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    ) {5 O* }$ c4 U2 |+ |2 d/ B1 B8 t
14.                 E.Linetype = "Continuous"
    0 W3 I% |0 G# W5 r
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    1 s5 v, g/ ]* g8 ?
19.                 E.color = 1
    7 y, q& d7 G  u
20.                 E.Linetype = "CENTER"
    8 K2 J* d/ r- Z. |" C3 G4 d
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    
24. End Sub
    + i( \  G0 O" t- d( [
25. 
    9 h$ l; A  ]" Q/ G
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    # A% Z" \' I  _
28.     For Each T In ThisDrawing.Linetypes
    9 e3 Z8 Q4 n, u) _4 s
29.         If T.Name = S Then
    
30.             B = True
    
31.             Exit For
    
32.         End If
    $ Z1 G" q- g) Y' p
33.     Next
    8 `$ Q4 j5 A: N8 w2 |; \" a9 `
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    7 c+ A* s: H# t0 Z6 D

复制代码

哥哥很善良

用下面的程序:
) [; g! k0 M; y# Z3 H/ c+ ?(if (not (tblsearch "layer" "xuxian"))
    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
# X+ }/ w( U% \% ^    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
1 N7 z# p3 C) v3 ~6 I(defun c:chgla ()
& P) I5 J. M" v: }* R  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
( `0 ^. n9 T( }% P8 L! B+ h    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
: D* f' C4 \4 F/ |6 l7 ~) ^    (if (= linee "HIDDEN")
& P" b' ^9 ?' t0 M1 S- a8 ^4 X( J       (command "change" ee """p" "la" "xuxian" "")
0 w: F, M0 G' I5 g: l5 B$ E6 Z* f      )
6 x  @* Y& A( C1 t4 \6 l( v    (setq i (+ i 1))
! h, C! K# C/ j4 P2 z4 [$ U; P   )
)
8 D$ i4 G3 f. {; _% W8 A7 v8 G  
用上面的方法可去把不同的线型分出去。