自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
求助,自動轉換 層，顏色，線型 .LSP
如下圖

謝謝

sealive_leafage

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

$ R: z# s! D5 x  J; D' B* S8 ?) l[ 本帖最后由 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
感謝樓上回復,不知哪裡可下載

$ i; K( u2 j4 j: s/ d% v不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
" r! d/ [1 c5 B0 |) X5 _

BILL.PU

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

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   + H8 H. b1 w- L% z' i6 q' |
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   & E1 ^, Y( ]  w8 F# t% p
5.     LoadLineType "HIDDEN"
   % R" O0 C/ H7 l: \$ ^
6.     LoadLineType "CENTER"
   + y6 ]( w7 o9 [' h; k- _- o+ v4 g
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    / g) c1 u) Z( ]0 y3 E& A1 N) v& j' V
11.                 E.Linetype = "Continuous"
    ) j5 f/ {/ Q. Y
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    5 q! X: S* S( j6 k
14.                 E.Linetype = "Continuous"
    
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    
17.                 E.Linetype = "HIDDEN"
    ) w) U! ?0 [6 z" k. {
18.             Case "中心线(ISO)", "中心标记(ISO)"
    % N5 W$ z# m; ~3 U
19.                 E.color = 1
    " R0 h1 ?# q/ s$ F/ C+ @8 F  i
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    3 \5 Z- P+ V! q- O' @% S2 M
23.     Next
    4 m* s/ A7 M! v8 |% S& G
24. End Sub
    
25. 
    
26. Private Sub LoadLineType(S As String)
    
27.     Dim T As AcadLineType, B As Boolean
    6 M' U! i) D& Z
28.     For Each T In ThisDrawing.Linetypes
    ( h8 ^& w" }' E" ~
29.         If T.Name = S Then
    . }5 k. c. X( r; N3 z
30.             B = True
    , ]* P9 l! k" J' z0 S
31.             Exit For
    3 ~" l0 t( B$ L8 s
32.         End If
    
33.     Next
    / \, r. U( J; A1 T3 |7 }& t* I0 O/ ~
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
4 P$ I0 f$ D* D9 W& R$ \( t- D0 \" X(if (not (tblsearch "layer" "xuxian"))
6 |, W* z9 I0 I( m/ Y' [# }7 n, H    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
/ y: N* `% x# S' ?" l( {  (setq en (ssget "all") n (sslength en) i 0)
$ A, @0 u5 C2 z% J  (repeat n
    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
9 `, ^; f9 z) x$ o& Q    (if (= linee "HIDDEN")
' {9 b2 B" G' x- `       (command "change" ee """p" "la" "xuxian" "")
      )
  a4 D) `' J+ G( \    (setq i (+ i 1))
- G2 X# ~) K3 i# s. f   )
: e0 `/ a4 c5 t: L)
  
7 N9 d- n* d  T2 J; h2 _8 [用上面的方法可去把不同的线型分出去。