自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
( r. a3 `2 n2 I6 E  q7 O7 v求助,自動轉換 層，顏色，線型 .LSP
如下圖

謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
/ {' P/ t+ J- W( h0 [1 H9 C
[ 本帖最后由 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就可以了。
6 w/ R" W1 H8 W+ s$ f4 K/ J

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
8 E4 y4 W: ]- {0 w8 p3 x所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   ! r) b. U/ c0 e! E# I& F7 p
2. Sub A()
   + P* n% l. c4 H7 h& z8 q
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   + y7 V& G# N1 {8 b1 K
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   ( L" [$ }9 G; e6 q% \$ e
7.     For Each E In ThisDrawing.ModelSpace
   - W6 u  p7 ?- C" J! T
8.         Select Case E.Layer
   . j9 r1 \; P1 L; x; W3 v; G
9.             Case "可见(ISO)"
   8 Q6 I% c6 t, s% ]/ i8 I3 ?
10.                 E.color = 7
    ! }6 |  t1 G3 v0 {7 G, c
11.                 E.Linetype = "Continuous"
    ! n. Q5 M6 `# n2 N* k3 Q( |
12.             Case "窄部可见(ISO)"
    3 R6 A9 o( n5 X% V" `0 w
13.                 E.color = 5
    + b; c$ l+ p$ `' `* F  v
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    7 d8 c3 D/ A* M; p1 H# X# K3 l
16.                 E.color = 4
    * s+ H9 J/ M2 ~3 `+ J9 D
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    9 u' A5 M6 y9 F- J
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    - K2 d& C  ?. z7 `9 _/ `
24. End Sub
    
25. 
      u; R, o3 Z$ [' Q5 n& P- J+ W) @
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    / c4 H) V' Z! L$ ]; v) l
29.         If T.Name = S Then
    
30.             B = True
    1 O7 y1 _. _5 Y- g, {8 j! \
31.             Exit For
    
32.         End If
    
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    - H/ f3 K1 q  F

复制代码

哥哥很善良

用下面的程序:
5 X# u* y8 P' k+ ~; i, m(if (not (tblsearch "layer" "xuxian"))
5 R8 p( E! H/ J- Q- B5 T8 d    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
: S- @+ Q; t$ D7 b* ^" i7 ^                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
, W! O  v# q4 b: K. @+ p& {! M  (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
/ A+ v, E- K0 F# g3 ]- w    (if (= linee "HIDDEN")
8 @! f4 e$ o$ M& A+ {% |       (command "change" ee """p" "la" "xuxian" "")
      )
+ \% @! `' \/ }    (setq i (+ i 1))
   )
)
  
4 o: f; ~& V- _用上面的方法可去把不同的线型分出去。