自動轉換 層，顏色，線型

BILL.PU

Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型
1 o# o7 o- U. V3 U, v0 t求助,自動轉換 層，顏色，線型 .LSP
如下圖
$ t5 ^4 O* m/ _( d+ @. k% M
* i* O. y+ u9 }. {謝謝

sealive_leafage

使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；
% k' X) w& i9 Q& J7 _# Z* K5 r, [
% k$ k$ e' w9 e[ 本帖最后由 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

謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
" b# q% X5 t5 s. [/ j3 i) {1 A所以需要寫程式

woaishuijia

VBA代码,供参考

1. 
   
2. Sub A()
   1 y' \! K6 q$ v& o' U  Z, X
3.     Dim E As AcadEntity
   
4.     ThisDrawing.Layers.Add "AA"
   / u+ D* `/ j- M6 Z# a
5.     LoadLineType "HIDDEN"
   
6.     LoadLineType "CENTER"
   
7.     For Each E In ThisDrawing.ModelSpace
   
8.         Select Case E.Layer
   
9.             Case "可见(ISO)"
   
10.                 E.color = 7
    
11.                 E.Linetype = "Continuous"
    
12.             Case "窄部可见(ISO)"
    
13.                 E.color = 5
    
14.                 E.Linetype = "Continuous"
    8 U3 p6 ?8 ?( x& d" [: B/ y
15.             Case "隐藏(ISO)"
    
16.                 E.color = 4
    
17.                 E.Linetype = "HIDDEN"
    
18.             Case "中心线(ISO)", "中心标记(ISO)"
    2 X9 D; V) x3 q* j
19.                 E.color = 1
    , @1 o# P* V8 A' f4 d4 Z0 ]
20.                 E.Linetype = "CENTER"
    
21.         End Select
    
22.         E.Layer = "AA"
    
23.     Next
    6 }8 F7 M; ^* n
24. End Sub
    
25. 
    9 y) C- j; Q& V3 l! q
26. Private Sub LoadLineType(S As String)
    2 X9 C/ ?3 z. h
27.     Dim T As AcadLineType, B As Boolean
    & J9 T1 b5 ~" [5 T: W+ g3 b
28.     For Each T In ThisDrawing.Linetypes
    & U, H% a% i1 q8 P' f1 a
29.         If T.Name = S Then
    2 U, E% [9 n( o0 \% {* r4 F
30.             B = True
    
31.             Exit For
    
32.         End If
    , F. [0 x( \( g! N: [
33.     Next
    
34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    
35. End Sub
    

复制代码

哥哥很善良

用下面的程序:
(if (not (tblsearch "layer" "xuxian"))
: ~$ B7 `- S$ F    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
& `8 j) Z4 u( I    )                                                 ;;;上面是你图上无xuxian层它自动去建立。
                           ;;;你是在同一层上画了不同的线型
(defun c:chgla ()
  (setq en (ssget "all") n (sslength en) i 0)
  (repeat n
    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
    (if (= linee "HIDDEN")
* U) K/ q8 f. [1 A) V  \       (command "change" ee """p" "la" "xuxian" "")
      )
' A; Y* ]1 L' p% D7 {& h& C    (setq i (+ i 1))
+ n' k$ \0 |+ O/ v   )
. i7 A5 P4 M4 J1 d4 E7 R# L)
  L# i; K8 N) W) z0 t7 N  s  V  
1 n1 u( [% y' P, |& H用上面的方法可去把不同的线型分出去。