三维网

标题: 自動轉換 層，顏色，線型 [打印本页]
作者: BILL.PU    时间: 2009-12-9 23:02
标题: 自動轉換 層，顏色，線型
Autodesk Inventor 3D圖轉AutoCAD 每次都要一一改,層，顏色，線型! L; M7 M- L2 b. x
求助,自動轉換 層，顏色，線型 .LSP3 B) N! F! p9 m5 @* j: w" p! G+ r$ Q* ~
如下圖 9 u! R8 Y' [: t. d; K9 q

4 Q# R7 }" m7 g# `; T* p: c謝謝[attach]1517784[/attach]
作者: sealive_leafage    时间: 2009-12-10 19:32
使用命令laytrans可以图层转换，只要你有一个含有标准图层设置的样本文件（dwt）就可以方便的映射转换了；1 d! m* x! W  H4 [; }5 X
# ^. z, b2 U, ]: p' e, i0 v0 P
[ 本帖最后由 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) N' |. C5 O( D# e: J/ \
感謝樓上回復,不知哪裡可下載
' h+ i4 {4 P* ~; c) E" _
不用下载，这是CAD自带的一个功能。位置就在菜单“工具”——“CAD标准”——“图层转换器”或者输入命令LAYTRANS就可以了。7 l1 f; W, ^/ g* L/ T
[attach]1518675[/attach]
作者: BILL.PU    时间: 2009-12-11 19:27
謝謝指導!試過後不是個人所需,相同層只能同一顏色同一線型5 [2 o! `1 \- B" ^, E6 B
所以需要寫程式
作者: woaishuijia    时间: 2009-12-11 21:17
VBA代码,供参考

  1. * ~0 o* Y* R! s
  2. Sub A()" ~% B) M# A1 h  @2 s5 i* C
  3.     Dim E As AcadEntity
    9 M0 s, d6 L( u2 n8 ]. |, B& M
  4.     ThisDrawing.Layers.Add "AA") l$ b& y6 k% O
  5.     LoadLineType "HIDDEN"7 b) S2 g6 X9 Y( }7 F
  6.     LoadLineType "CENTER"1 J/ C9 M! T( T
  7.     For Each E In ThisDrawing.ModelSpace
    9 Z* l+ q& [* r# K
  8.         Select Case E.Layer3 Q5 ^( i' x7 `7 I; }
  9.             Case "可见(ISO)"4 I: W8 `- S" q
  10.                 E.color = 7
    - @8 U+ h3 s5 m+ r& E
  11.                 E.Linetype = "Continuous"5 A" R" Q; m$ [8 |3 ?! D8 e# w
  12.             Case "窄部可见(ISO)"% q$ l2 n% O3 ~$ N9 l  F7 M6 K* M( S
  13.                 E.color = 5+ a" I; W# B/ z% F" f* E" L
  14.                 E.Linetype = "Continuous"
    ; e! [$ T: A) q6 I
  15.             Case "隐藏(ISO)"
    ! Y( K* _5 b! R( z, g$ N
  16.                 E.color = 4
    & K" z, ]( N+ b' D+ L7 c# @, D
  17.                 E.Linetype = "HIDDEN"
    6 n. s8 B* ^: _% [, e+ I; y' k0 ?
  18.             Case "中心线(ISO)", "中心标记(ISO)"! f: D+ `- i, c% ?: U
  19.                 E.color = 1
    , W8 M) y. n$ c1 p( k0 O7 W) G
  20.                 E.Linetype = "CENTER"
    # {5 W( b- b8 d6 D
  21.         End Select& Y# x6 r9 Z7 i  Y
  22.         E.Layer = "AA"" \: F9 m% ]7 {; o! i
  23.     Next8 j6 C5 @8 b" s% O0 k. L* K2 X/ e
  24. End Sub
    4 J5 S# D' v, c- |" g

  25. 6 j7 V3 i# R( j  O& F& H0 b5 x# p2 Q
  26. Private Sub LoadLineType(S As String)
    2 b- m  n! ^1 S  i
  27.     Dim T As AcadLineType, B As Boolean
    9 S6 L% Z1 F" s* V4 ^/ o4 a9 J
  28.     For Each T In ThisDrawing.Linetypes
    9 W& m; c- u1 m5 W/ l& X1 p/ O
  29.         If T.Name = S Then1 s: P5 A0 ]& K  }, H5 [
  30.             B = True
    2 R% `' L/ q* y5 n- X
  31.             Exit For2 J  Y% f7 J4 R. _
  32.         End If
    ) v1 E$ F5 y% z* b8 }
  33.     Next
    . i5 _- ]9 o2 C" w0 c
  34.     If Not B Then ThisDrawing.Linetypes.Load S, "acadiso.lin"
    3 A& j! y0 Z0 g3 \3 j
  35. End Sub
    , _6 @. `4 U7 C0 v5 A! `% L
复制代码
作者: 哥哥很善良    时间: 2010-1-2 17:55
用下面的程序:/ u2 l- P0 Y; j) ]
(if (not (tblsearch "layer" "xuxian"))
; ?9 O$ s3 ]7 K6 s+ j0 U: P* ~5 p! E. i    (command "layer" "n" "xuxian" "l" "hidden" "xuxian" "c" "3" "xuxian" "")
* x# f7 i: {/ y+ o* o3 K! k' \5 Z    )                                                 ;;;上面是你图上无xuxian层它自动去建立。7 K. _8 c/ [3 r" A
                           ;;;你是在同一层上画了不同的线型
: D5 r, {/ B: g7 ?& |  z' Q(defun c:chgla ()8 {1 @8 l0 {! ]. z% }
  (setq en (ssget "all") n (sslength en) i 0)) e% l! m6 l" M7 c+ T
  (repeat n. q+ T& T0 B( {7 G, Y, a
    (setq ee (ssname en i) en1 (entget ee) linee (cdr (assoc 6 en1)))    ;;;只有在同一层上画了不同的线型有6
+ ?7 _# d6 d0 O    (if (= linee "HIDDEN")
1 L* W6 J) b$ m5 q       (command "change" ee """p" "la" "xuxian" "")
4 J6 d9 ~1 g  u9 v% @      )9 x% N8 O) D$ r% E
    (setq i (+ i 1))! O* o2 H& N# t# v; F% P5 H
   )
5 m  N2 k; Q8 T  ?8 a2 F8 o2 n)
- a* j7 U" }7 N# }  
: u' l1 d( Y+ H用上面的方法可去把不同的线型分出去。



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