自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
- D( r6 a6 D; h: H' e. Z5 m& a如下圖
; l' O1 B- @2 A& Z
謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
' H6 Y$ M; r. t, }  t& A
[ 本帖最后由 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
* ~; q0 R- J$ j# g感謝樓上回復,不知哪裡可下載

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

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
" {; a  Y4 g0 P0 ]5 c& v4 B; R- J/ R所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   % \/ l. ]7 u& F' w* o1 G
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   / \2 k# P/ ?7 z* E$ I6 O- X
5.     LoadLineType "HIDDEN"
   + y' z0 F1 w1 d/ g3 |+ B3 g, ?; o8 B: ~
6.     LoadLineType "CENTER"
     N% W/ {6 u; h$ y! r0 a; M# |
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   $ S/ }* u7 W  |; ~
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    " t, B2 J) D9 V+ T# ]9 l% M
12.             Case "窄部可见(ISO)"
    0 K, l7 D4 T5 n) f5 L
13.                 E.color = 5
    7 d) @- h& s2 b
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    1 `) w2 x/ u. A5 u  M4 O* ?! i
16.                 E.color = 4
    , V! ?9 r% h/ n3 u+ C! ~
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    - x5 }) ]* K# i; {: Q$ H: [& \8 {6 G
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    
24. End Sub
    # y( f9 x3 y. f1 ~- y" b* {, V, p( {
25. 
    
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    
29.         If T.Name = S Then
    * |7 e0 g; n5 |; g! K
30.             B = True
    
31.             Exit For
    + o3 F! W1 G1 {) F1 H& G4 ]+ ~/ J
32.         End If
    5 t8 Q2 \- z6 c; w; T$ n
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
. C& y" H' }5 U- e' U4 e$ f/ Z    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
. c9 j: p. b8 m) n3 v$ z& T- o    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
. q( ], J. C/ p# S! B( C(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
& b" Z3 O9 b* Q8 G3 q8 K# _3 ]2 j  (repeat n
    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
5 T7 `) K0 m" M9 q+ i) ?    (if (= linee "HIDDEN")
       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
   )
5 E; I6 b  S- b9 x/ F)
  
用上面的方法可去把不同的线型分出去。