三维网

标题: 自動轉換 層,顏色,線型 [打印本页]

作者: BILL.PU    时间: 2009-12-9 23:02
标题: 自動轉換 層,顏色,線型
Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層,顏色,線型, l. N3 ?4 k6 s
求助,自動轉換 層,顏色,線型 .LSP
! i) N$ U4 N3 n/ Z7 `" Q5 a如下圖 $ d( B; j, \! i+ s! G' e9 q8 P
/ S: s8 [3 X+ c& c2 L: z, l, A% p
謝謝[attach]1517784[/attach]
作者: sealive_leafage    时间: 2009-12-10 19:32
使用命令laytrans可以图层转换,只要你有一个含有标准图层设置的样本文件(dwt)就可以方便的映射转换了;
0 c- ^/ o1 `: q6 U" w5 a# V
1 H* t7 S% ]2 Z* G( M6 {[ 本帖最后由 sealive_leafage 于 2009-12-10 19:34 编辑 ]
作者: BILL.PU    时间: 2009-12-10 20:47
感謝樓上回復,不知哪裡可下載
作者: rongjian    时间: 2009-12-10 21:51
原帖由 BILL.PU 于 2009-12-10 20:47 发表 http://www.3dportal.cn/discuz/images/common/back.gif( r8 D" Y* I" D
感謝樓上回復,不知哪裡可下載

. [0 ^) M% `* {  w; m/ c不用下载,这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。
$ V$ V3 _4 b0 _0 l[attach]1518675[/attach]
作者: BILL.PU    时间: 2009-12-11 19:27
謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型
2 L6 n2 o; i. a$ A) d所以需要寫程式
作者: woaishuijia    时间: 2009-12-11 21:17
VBA代码,供参考

  1. # L9 D: P( E3 n1 P, F8 j% L
  2. Sub A()
    # |" R7 T$ {7 p6 A1 b& H) e
  3.     Dim E As AcadEntity: Y& \/ C; y  N, g
  4.     ThisDrawing.Layers.Add "AA"
    : n4 c! r7 h+ ~! ~  I) Z, T
  5.     LoadLineType "HIDDEN"
    6 |2 r' S. T2 z( H% v  [* T
  6.     LoadLineType "CENTER") c% Z, J9 ?; I% q4 V  p
  7.     For Each E In ThisDrawing.ModelSpace, |2 `, q2 Q: e/ n2 G3 }9 A
  8.         Select Case E.Layer
    # S% M) g# u: D; Y  P, c
  9.             Case "可见(ISO)". [( X1 d& T. E8 W8 ]0 @8 Z* f  l; {
  10.                 E.color = 7/ H9 P4 }5 H; K
  11.                 E.Linetype = "Continuous"& L) ]. a9 q1 Q# U
  12.             Case "窄部可见(ISO)", B5 P. I" [  H. w8 ~' o/ M* X
  13.                 E.color = 5
    ' J6 j3 r2 s  K+ ~/ Y0 {
  14.                 E.Linetype = "Continuous"& K7 |1 p* i& a% t4 B
  15.             Case "隐藏(ISO)"
    0 a4 z. z+ C+ J. O4 _
  16.                 E.color = 4# ]) n0 e8 ?; w" p& \* r& x' S: Y1 Y
  17.                 E.Linetype = "HIDDEN"- Z1 J. m2 u6 i+ o
  18.             Case "中心线(ISO)", "中心标记(ISO)", r( r: D6 \, Q4 \* w# c
  19.                 E.color = 1' C1 h$ |' j/ d
  20.                 E.Linetype = "CENTER"
    6 L. x: u. u" [, R9 y
  21.         End Select& `/ m2 ]2 D( ]/ F
  22.         E.Layer = "AA"  P8 W! }4 S) @+ S" {5 c% N  L+ ^' a
  23.     Next
    & e  v2 q& C+ V5 I0 \6 M# \( X
  24. End Sub7 u2 H  r9 D- b; |1 a. e3 y1 t+ T# Z

  25. 0 G9 L, Q, W4 w4 L9 n! V
  26. Private Sub LoadLineType(S As String)/ k( g: a  ^- W; _; J+ s1 n. o
  27.     Dim T As AcadLineType, B As Boolean6 @! ~. A- Y: x4 w$ x
  28.     For Each T In ThisDrawing.Linetypes
    6 r* |* g# f( R, ^9 O: H: Q3 p0 G
  29.         If T.Name = S Then
    3 v2 X  `5 k% x9 k: f5 z# W
  30.             B = True/ m' h9 j7 g4 x- r) V
  31.             Exit For
    * q& s! \/ P( J% Y
  32.         End If
    1 E  f8 u; M5 r
  33.     Next+ o: C. H2 ?& K" w
  34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin". R4 H/ y9 U4 Q
  35. End Sub
    # p8 I% y1 D. k( J7 U  Y, J: p
复制代码

作者: 哥哥很善良    时间: 2010-1-2 17:55
用下面的程序:$ [1 Z# \, m4 [  p6 {; E# \; G# [
(if (not (tblsearch "layer" "xuxian"))
( U5 `% Q0 I5 r0 g  W    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
, y$ L0 s2 p6 h$ Y    )                                                 ;;;上面是你图上无xuxian层它自动去建立。" _8 s# J+ M* u" `* T3 x& y( t
                           ;;;你是在同一层上画了不同的线型
  O- d$ R/ `- r: Q/ @! s(defun c:chgla ()5 N. f4 [1 h; h5 I4 p4 q
  (setq en (ssget "all") n (sslength en) i 0)
) t( ?; ^6 |4 {, E  (repeat n
* K. w1 }! m5 `3 W3 l* |; }; ?4 m    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
6 r/ o' f$ `/ Q3 _) i    (if (= linee "HIDDEN")9 _- s: P* w  C, l: `4 I) ^2 ~0 b
       (command "change" ee """p" "la" "xuxian" "")7 K* p2 v$ ]8 l+ H, U5 V
      )
' n; {4 }! i$ A5 l* `, G" Z    (setq i (+ i 1))
' s- E& D. h" @4 i6 @4 \9 L& M: [   ): C/ H' V0 J; L! t" T6 N/ F, S% D
)
9 U/ v$ z5 O* ^% T6 {  
! W0 T, Z8 D" b% e* F# {( W用上面的方法可去把不同的线型分出去。




欢迎光临 三维网 (http://www.3dportal.cn/discuz/) Powered by Discuz! X3.4