自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
- Z/ ~: |5 g# s9 J: g求助,自動轉換 層，顏色，線型 .LSP
如下圖
# p- }% j$ C# c9 m% R$ l( s
謝謝

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

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

woaishuijia

VBA代码,供参考

1. 
   + ~2 i/ y  W' F% U$ Q
2. Sub A()
   
3.     Dim E As AcadEntity
   8 ?, g: r9 ?1 x# @0 _5 T& p* E
4.     ThisDrawing.Layers.Add "AA"
   
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   5 O5 _# ?+ h( V. w8 w2 V+ O
8.         Select Case E.Layer
   3 g7 W$ m9 s) k* B( x/ \2 W
9.             Case "可见(ISO)"
   9 y; ]# M- a: @) Z( w
10.                 E.color = 7
    , y9 y, c. J6 z/ R! N' W
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    3 ?' D- o% n  \7 B9 y8 ^! p4 ]
13.                 E.color = 5
    
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    & ^7 k) X7 n% K. j" _6 C# G
16.                 E.color = 4
    , \/ O, t8 R5 l5 H& V  z
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    % G$ z) N% i* \; R
19.                 E.color = 1
    & x# n% S, |9 ]) k3 h( `" t: Q$ I
20.                 E.Linetype = "CENTER"
    
21.         End Select
    $ i' Z* m) ~6 o. r* v
22.         E.Layer = "AA"
    * w$ F- s- a1 _) y( }. N
23.     Next
    
24. End Sub
    # V; C. G8 p; r9 o# O+ v
25. 
    % u# T( p7 H# t8 U% [
26. Private Sub LoadLineType(S As String)
    6 t+ I; u, g$ g# x' z: r: }. Z
27.     Dim T As AcadLineType, B As Boolean
    # I6 h8 p" J+ a# r
28.     For Each T In ThisDrawing.Linetypes
    ) b1 L+ e6 ~( ]- G9 X5 `( E- f
29.         If T.Name = S Then
    
30.             B = True
    ' |% m; k1 v# G
31.             Exit For
    
32.         End If
    6 r+ h# Z# s# P0 V( K
33.     Next
    * L. x$ Z: B8 S4 c$ ?
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    2 ^) \8 E& ^7 x, c  Z
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
0 b5 q: t; f4 q# q    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
, A, j9 Q( V5 [) _# p    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
$ s2 V0 C4 R; S% D6 }0 _                           ;;;你是在同一层上画了不同的线型
0 R9 v+ s. D- y2 q  Y, `! D(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
7 B- {* }" V' l5 W: R: |- ^    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
7 O7 [1 s& z* D# P7 @    (if (= linee "HIDDEN")
       (command "change" ee """p" "la" "xuxian" "")
) y) e$ k8 N/ h1 h# _      )
    (setq i (+ i 1))
   )
: X- \# C" e$ t: N9 t: g3 y)
  
用上面的方法可去把不同的线型分出去。