自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
% E/ ^7 }( n. Q- T) J7 g, p求助,自動轉換 層，顏色，線型 .LSP
' O! v  [/ a, W7 Z$ d; [3 a如下圖

- `' J% U+ o2 g( Z+ m謝謝

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

# J* u5 j$ G' I' n3 G9 w4 l' K不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
' E( U- x# }( n9 o2 a

BILL.PU

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

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   ) u$ [# V! j7 T
3.     Dim E As AcadEntity
   ! A( Z/ W) n; k/ \$ N2 Z
4.     ThisDrawing.Layers.Add "AA"
   
5.     LoadLineType "HIDDEN"
   4 j! d9 ^% m% y+ v# O& H
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   ( ]! O) I( k( s" b! j- M  V" B% E
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    5 c+ W& P2 Z/ E; z3 {% t
12.             Case "窄部可见(ISO)"
    9 B, w! F! B, c. Q
13.                 E.color = 5
    ! \9 _- t: D1 O) ?" D6 J  S
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    : }! r* I3 j0 {! r! c
16.                 E.color = 4
    " q- j6 V% w) [' E' J. ]
17.                 E.Linetype = "HIDDEN"
    5 @3 N; D; f0 K! b
18.             Case "中心线(ISO)", "中心标记(ISO)"
    
19.                 E.color = 1
    
20.                 E.Linetype = "CENTER"
    
21.         End Select
    " q( S% X7 t" u0 g
22.         E.Layer = "AA"
    
23.     Next
    
24. End Sub
    4 ?& h7 g) F# P. r! \$ r; a
25. 
    
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    0 \  f2 m# T7 p1 `! R& a+ Y' o
28.     For Each T In ThisDrawing.Linetypes
    4 U+ [/ F8 d# I" x6 _0 |/ [# U
29.         If T.Name = S Then
    9 H0 z2 g( @6 e+ s' S
30.             B = True
    
31.             Exit For
    ) w! ?. ?% e' \0 c& D
32.         End If
    ' A8 i, K0 K' V
33.     Next
    ' z* P4 }4 C& Y+ i
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
  k  R: g& H% t$ U% d- L7 F9 Y    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
. S5 `  T2 ], E8 H    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
" t1 d0 H# Q  @7 t6 W                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
: p% _& \1 H5 r5 `6 G' f    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
9 H% D5 }5 k% f3 h    (if (= linee "HIDDEN")
       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
   )
4 B' s5 x8 g) t. M. N)
+ o2 X: h2 @: b# ?  
用上面的方法可去把不同的线型分出去。