自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
5 Z! ?9 ^, {# F& ~, s- |* v& i( b如下圖

6 L  k+ `0 E# T% m- E. K: g謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；

  A! D2 l9 v( F[ 本帖最后由 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
感謝樓上回復,不知哪裡可下載

' _9 g, U+ H; d  J5 V7 b不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。

BILL.PU

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
" C  I. s: Z9 x) A* k* X所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   8 K2 b( J  H9 Y; y; z) p' ^
2. Sub A()
   
3.     Dim E As AcadEntity
   / {" H2 Q0 t4 N$ ]* b; H6 b0 @/ H
4.     ThisDrawing.Layers.Add "AA"
   
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   3 x0 w; t, d" [9 N# P+ W8 o) d
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   # G+ [( o4 \' E' q; }5 V. R$ R6 |
10.                 E.color = 7
    + \2 E5 _# q' m( ?4 s0 m1 y4 S- t
11.                 E.Linetype = "Continuous"
    * {) p$ _9 Y  C$ f; }) f) y
12.             Case "窄部可见(ISO)"
    / g: ]5 m* L- X8 }8 g
13.                 E.color = 5
    ; q. u  K! J' P/ H# w' c
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    4 u& t& n, M* a
17.                 E.Linetype = "HIDDEN"
    * ~) a) K3 o2 R0 s: }; P( ]8 I
18.             Case "中心线(ISO)", "中心标记(ISO)"
    + B8 J- v4 m' G) V4 }7 v3 h
19.                 E.color = 1
    3 J6 S3 ]% P! h
20.                 E.Linetype = "CENTER"
    + _2 {, [4 e7 T1 l0 J/ l! C
21.         End Select
    , x& e; I1 M, Y& B4 m1 A
22.         E.Layer = "AA"
    , @+ J' I' }+ x: U; i2 R
23.     Next
    
24. End Sub
    
25. 
    / f# W: w& `2 }; N# d- @7 w
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    
28.     For Each T In ThisDrawing.Linetypes
    / J' L# d: r2 y( c) Q
29.         If T.Name = S Then
    
30.             B = True
    
31.             Exit For
    ) p8 n! ^: s- v
32.         End If
    # K8 c) g) ?/ }! p% U
33.     Next
    7 y: W9 B3 k3 O: y  F* m7 ~! l
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    # x9 y/ ?# V, D

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
4 J& T3 [% d. O, p, s9 H8 k) }) \                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
  r- }9 \4 k+ M0 Y1 C    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
+ m2 u7 b# ?" D0 W: \) Q    (if (= linee "HIDDEN")
3 p/ ?) z% B* p' h       (command "change" ee """p" "la" "xuxian" "")
      )
    (setq i (+ i 1))
0 D4 E; _& h7 |: |& U   )
)
: C+ G5 z- L& f1 \+ ~. T& c  
' V4 W6 S; L) d+ ?% @+ H6 F; E用上面的方法可去把不同的线型分出去。