【Gu_xl】[原创]实用工具：Block 自动转为Lisp源代码

ahfoon

看起来是很神奇的

qingtao210

好牛啊，看来路还长

Gu_xl

hpy发表于2010-8-9 13:23:00如果能支持高版本的CAD就更好了。

测试了2008版本，可以正常运行！

kkt123

只能纯欣赏了!

感谢楼主分享!

yfywk

试着运行了依稀，生成的代码如下，但就是不知道怎样使用？

(defun MakeBlock-jt (/ obj obj1 obj2 objHatch HatchobjAray )
   (setvar "clayer" "0")
   (setq obj (GXL-AX:ADDBLOCK '(0 0 0) "jt"))
   (setq obj1 (GXL-AX:ADDLINE obj '(-1.0 0.0 0.0) '(1.0 0.0 0.0)))
   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "0") "7")
   (vla-put-color obj1 "256")
   (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "acadiso.lin")))
   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "EstateCADTools.lin"))))
   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "ByLayer"))
    (vla-put-LinetypeScale obj1 1)
   (setq obj1 (vla-AddLightWeightPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 4))'(-0.459619 -0.459619 0.459619 0.459619)))))
   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "0") "7")
   (vla-put-color obj1 "256")
   (vla-put-ConstantWidth obj1 0.45)
   (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "acadiso.lin")))
   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "EstateCADTools.lin"))))
   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "ByLayer"))
   (vla-put-LinetypeScale obj1 1)
  )

Gu_xl

yfywk发表于2010-9-5 17:35:00试着运行了依稀，生成的代码如下，但就是不知道怎样使用？ (defun MakeBlock-jt (/ obj obj1 obj2 objHatch HatchobjAray )   ...

请仔细阅读一楼的帖子！

kaka8008

这个工具很强大啊！

jialiang168

可惜不是源码只能欣赏了。盼楼主分享源码。或转繁体谢谢！

Gu_xl

应大家的要求，现将源码公布如下，供大家共同交流：

2. 
   
3. ;;; gxl-Blk-Check 检查定义图块
   
4. ;;;C:Block->Lisp1 由图块自动转为Lisp代码，可以处理嵌套块，但不能处理复杂的块
   
5. ;;; c:BlockIn 在图形中插入某目录下的全部图形，
   
6. ;;;******************************************************
   
7. ;;;C:Block->Lisp1 由图块自动转为Lisp代码，可以处理嵌套块，但不能处理复杂的块
   
8. (DEFUN C:BlockToLisp (/ ListMutiBlock       MakeEntity BlockLisp
   
9.    BlockLisp1 blkList    OpenFile  en
   
10.    ss    ss1       pt1  pt2
    
11.    R    Ang1       Ang2  mk
    
12.    mn    tmp_Fn     BlockName  BlockNameList
    
13.          ) ;_ /
    
14.   ;;;展开嵌套块中最基本图块单元，由低到高顺序
    
15. (defun ListMutiBlock (BlockName / rtn listblkref blklst obj obj1 Bname)
    
16.   (defun listblkref (Name / objblk rtn1 obj2)
    
17.     (setq objblk (vla-item (vla-get-blocks *ACDOCUMENT*) Name)
    
18.    rtn1 (list Name))
    
19.   (vlax-for obj2 (vla-Item (vla-get-Blocks *AcDocument*) (vla-get-name objblk))
    
20.    (if (= "AcDbBlockReference" (vla-get-ObjectName obj2))
    
21.      (progn
    
22.        (setq Name (vla-get-Name obj2))
    
23.      ;(if (listblkref name) (setq rtn1 (append rtn1 (list (list name (listblkref name)))))(setq rtn1 (append (list name))))
    
24.      (setq rtn1 (append rtn1 (list  (listblkref name))))
    
25.      )
    
26.      )
    
27.     (setq obj2 nil)
    
28.    )
    
29.     (setq objblk nil)
    
30.     (gxl-ListDumpAtom rtn1)
    
31.   )
    
32.   (setq obj (vla-item (vla-get-blocks *ACDOCUMENT*) BlockName))
    
33.   (vlax-for obj1 obj
    
34.      (if (= "AcDbBlockReference" (vla-get-ObjectName obj1))
    
35.        (progn
    
36.   (setq  Bname (vla-get-Name obj1))
    
37.   ;(if (listblkref Bname) (setq rtn (append rtn (list (list Bname (listblkref Bname))))) (setq rtn (append (list Bname))))
    
38.      (setq rtn (append rtn  (list  (listblkref Bname))))
    
39.      )
    
40.    )
    
41.     (setq obj1 nil)
    
42.    )
    
43.   (setq obj nil)
    
44. (setq rtn (gxl-RemoveItem nil (gxl-ListDumpAtom rtn)))
    
45.   (reverse (setq rtn (gxl-onelist rtn)))
    
46. )
    
47.   ;;;块写实体,包含Hatch实体
    
48.   (defun MakeEntity (obj /        pt1      pt2
    
49.     La        Plottable     color
    
50.     LaColor       lineType      LineTypeScale
    
51.     R        pts      clo
    
52.     CONSTANTWIDTH StartTangent  EndTangent
    
53.     Height        xz      kb
    
54.     qx        Alignment     style
    
55.     objTextStyle  FontFile      BigFontFile
    
56.     Font        styleHeight   stylebliqueAngle
    
57.     styleScale    TextString    textaligmentpoint
    
58.     Width        AttachmentPoint
    
59.     InsertionPoint       mode
    
60.     $Prompt       Tag      Value
    
61.     P1        P2      P3
    
62.     P4        Center      MajorAxis
    
63.     RadiusRatio   StartAngle    EndAngle
    
64.     PatternType   PatternName   Associative
    
65.     NumberOfLoops PatternScale  PatternAngle
    
66.     HatchStyle    HatchObjectType
    
67.     InsPt        BName      Xscale
    
68.     Yscale        Zscale      Rotation
    
69.            lineweight
    
70.    ) ;_ obj
    
71.     (setq ObjectName (vla-get-ObjectName obj)
    
72.    Handle (vla-get-Handle obj)
    
73.    )
    
74.     (cond ((= "AcDbLine" ObjectName)
    
75.     (setq pt1 (GXL-STR-STOA (vlax-curve-getStartPoint obj))
    
76.    pt2 (GXL-STR-STOA (vlax-curve-getEndPoint obj))
    
77.    La (vla-get-Layer obj)
    
78.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
    
79.    color (vla-get-color obj)
    
80.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
    
81.    lineType (vla-get-linetype obj)
    
82.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
    
83.    lineweight (rtos (vla-get-lineweight obj) 2)
    
84.    )
    
85.     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDLINE obj \'" pt1 " \'" pt2 "))") OpenFile)
    
86.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
    
87.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
    
88.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
    
89.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
    
90.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
    
91.     (WRITE-LINE (strcat
    
92.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
    
93.     (WRITE-LINE (strcat
    
94.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
    
95.     lineType "" "EstateCADTools.lin"))))") OpenFile)
    
96.     (WRITE-LINE (strcat
    
97.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
    
98.     (WRITE-LINE (strcat "    (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
    
99.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
    
100.     )
     
101.    ((= "AcDbCircle" ObjectName)
     
102.     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))
     
103.    R (rtos (vla-get-radius obj) 2)
     
104.    La (vla-get-Layer obj)
     
105.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
106.    color (vla-get-color obj)
     
107.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
108.    lineType (vla-get-linetype obj)
     
109.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
110.    lineweight (rtos (vla-get-lineweight obj) 2)
     
111.    )
     
112.     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDCIRCLE obj \'" pt1 " " R "))") OpenFile)
     
113.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
114.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
115.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
116.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
117.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
118.     (WRITE-LINE (strcat
     
119.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
120.     (WRITE-LINE (strcat
     
121.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
122.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
123.     (WRITE-LINE (strcat
     
124.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
125.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
126.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
127.     )
     
128.    ((= "AcDbArc" ObjectName)
     
129.     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))
     
130.    R (rtos (vla-get-radius obj) 2)
     
131.    Ang1 (rtos (vla-get-StartAngle obj) 2)
     
132.    Ang2 (rtos (vla-get-endAngle obj) 2)
     
133.    La (vla-get-Layer obj)
     
134.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
135.    color (vla-get-color obj)
     
136.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
137.    lineType (vla-get-linetype obj)
     
138.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
139.    lineweight (rtos (vla-get-lineweight obj) 2)
     
140.    )
     
141.     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddArc obj \'" pt1 " "  R " "  Ang1 " "  Ang2 "))") OpenFile)
     
142.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
143.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
144.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
145.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
146.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
147.     (WRITE-LINE (strcat
     
148.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
149.     (WRITE-LINE (strcat
     
150.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
151.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
152.     (WRITE-LINE (strcat
     
153.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
154.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
155.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
156.     )
     
157.    ((= "AcDbPolyline" ObjectName)
     
158.     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-Coordinates obj)))
     
159.    bulges (cadr (GXL-GET_POLY_DATA obj))
     
160.    clo (vla-get-Closed obj)
     
161.    CONSTANTWIDTH (vla-get-ConstantWidth obj)
     
162.    La (vla-get-Layer obj)
     
163.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
164.    color (vla-get-color obj)
     
165.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
166.    lineType (vla-get-linetype obj)
     
167.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
168.    lineweight (rtos (vla-get-lineweight obj) 2)
     
169.    )
     
170.     (WRITE-LINE
     
171.       (strcat
     
172.         "   (setq obj1 (vla-AddLightWeightPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "
     
173.         (itoa (length (read pts)))
     
174.         "))\'"
     
175.         pts
     
176.         "))))"
     
177.       ) ;_ strcat
     
178.       OpenFile
     
179.     ) ;_ WRITE-LINE
     
180.     (setq n 0)
     
181.     (foreach bulge bulges
     
182.       (if (/= bulge 0.0) (WRITE-LINE (strcat "  (vla-SetBulge obj1 " (itoa n) " " (rtos bulge 2) ")") OpenFile))
     
183.       (setq n (1+ n))
     
184.       )
     
185.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
186.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
187.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
188.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
189.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
190.     (if (= clo :vlax-true)
     
191.       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)
     
192.       )
     
193.     (if (not (equal CONSTANTWIDTH 0.0))
     
194.       (progn
     
195.         (setq CONSTANTWIDTH (rtos CONSTANTWIDTH 2))
     
196.         (WRITE-LINE  (strcat "   (vla-put-ConstantWidth obj1 " CONSTANTWIDTH ")") OpenFile)
     
197.         )
     
198.       )
     
199.     (WRITE-LINE (strcat
     
200.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
201.     (WRITE-LINE (strcat
     
202.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
203.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
204.     (WRITE-LINE (strcat
     
205.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
206.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
207.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
208.     )
     
209.    ((= "AcDb2dPolyline" ObjectName)
     
210.     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-Coordinates obj)))
     
211.    bulges (cadr (GXL-GET_POLY_DATA obj))
     
212.    clo (vla-get-Closed obj)
     
213.    CONSTANTWIDTH (vla-get-ConstantWidth obj)
     
214.    La (vla-get-Layer obj)
     
215.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
216.    color (vla-get-color obj)
     
217.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
218.    lineType (vla-get-linetype obj)
     
219.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
220.    lineweight (rtos (vla-get-lineweight obj) 2)
     
221.    )
     
222.     (WRITE-LINE
     
223.       (strcat
     
224.         "   (setq obj1 (vla-AddPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "
     
225.         (itoa (length (read pts)))
     
226.         "))\'"
     
227.         pts
     
228.         "))))"
     
229.       ) ;_ strcat
     
230.       OpenFile
     
231.     ) ;_ WRITE-LINE
     
232.     (setq n 0)
     
233.     (foreach bulge bulges
     
234.       (if (/= bulge 0.0) (WRITE-LINE (strcat "  (vla-SetBulge obj1 " (itoa n) " " (rtos bulge 2) ")") OpenFile))
     
235.       (setq n (1+ n))
     
236.       )
     
237.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
238.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
239.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
240.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
241.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
242.     (if (= clo :vlax-true)
     
243.       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)
     
244.       )
     
245.     (if (not (equal CONSTANTWIDTH 0.0))
     
246.       (progn
     
247.         (setq CONSTANTWIDTH (rtos CONSTANTWIDTH 2))
     
248.         (WRITE-LINE  (strcat "   (vla-put-ConstantWidth obj1 " CONSTANTWIDTH ")") OpenFile)
     
249.         )
     
250.       )
     
251.     (WRITE-LINE (strcat
     
252.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
253.     (WRITE-LINE (strcat
     
254.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
255.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
256.     (WRITE-LINE (strcat
     
257.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
258.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
259.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
260.     )
     
261.    ((= "AcDbSpline" ObjectName)
     
262.     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-FitPoints obj)))
     
263.    clo (vla-get-Closed obj)
     
264.    La (vla-get-Layer obj)
     
265.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
266.    StartTangent (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-StartTangent obj)))
     
267.    EndTangent (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-endTangent obj)))
     
268.    color (vla-get-color obj)
     
269.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
270.    lineType (vla-get-linetype obj)
     
271.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
272.    lineweight (rtos (vla-get-lineweight obj) 2)
     
273.    )
     
274.     (WRITE-LINE
     
275.       (strcat
     
276.         "   (setq obj1 (vla-AddSpline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "
     
277.         (itoa (length (read pts)))
     
278.         "))\'"
     
279.         pts
     
280.         ")) (vlax-3d-point \'" StartTangent ") (vlax-3d-point \'" EndTangent ")))"
     
281.       ) ;_ strcat
     
282.       OpenFile
     
283.     ) ;_ WRITE-LINE
     
284.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
285.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
286.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
287.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
288.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
289.     (if (= clo :vlax-true)
     
290.       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)
     
291.       )
     
292.    
     
293.     (WRITE-LINE (strcat
     
294.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
295.     (WRITE-LINE (strcat
     
296.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
297.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
298.     (WRITE-LINE (strcat
     
299.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
300.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
301.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
302.     )
     
303.    ((= "AcDbText" ObjectName)
     
304.     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))
     
305.    Height (rtos (vla-get-Height obj) 2)
     
306.    xz (rtos (vla-get-Rotation obj) 2)
     
307.    kb (rtos (vla-get-ScaleFactor obj) 2)
     
308.    qx (rtos (vla-get-ObliqueAngle obj) 2)
     
309.    Alignment (vla-get-alignment obj)
     
310.    style (vla-get-StyleName obj)
     
311.    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)
     
312.    FontFile (vla-get-FontFile objTextStyle)
     
313.    BigFontFile (vla-get-BigFontFile objTextStyle)
     
314.    Font (strcat FontFile "," BigFontFile)
     
315.    styleHeight (rtos (vla-get-Height objTextStyle) 2)
     
316.    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)
     
317.    ;styleScale (rtos (vla-get-ScaleFactor objTextStyle) 2)
     
318.    TextString (vla-get-TextString obj)
     
319.    La (vla-get-Layer obj)
     
320.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
321.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
322.    color (vla-get-color obj)
     
323.    textaligmentpoint (GXL-STR-STOA (GXL-NUM-AX->LISPVALUE(vla-get-TextAlignmentPoint obj)))
     
324.    lineweight (rtos (vla-get-lineweight obj) 2)
     
325.    )
     
326.     (cond ((= 0 Alignment) (setq Alignment "acAlignmentLeft"))
     
327.    ((= 1 Alignment) (setq Alignment "acAlignmentCenter"))
     
328.    ((= 2 Alignment) (setq Alignment "acAlignmentRight"))
     
329.    ((= 3 Alignment) (setq Alignment "acAlignmentAligned"))
     
330.    ((= 4 Alignment) (setq Alignment "acAlignmentMiddle"))
     
331.    ((= 5 Alignment) (setq Alignment "acAlignmentFit"))
     
332.    ((= 6 Alignment) (setq Alignment "acAlignmentTopLeft"))
     
333.    ((= 7 Alignment) (setq Alignment "acAlignmentTopCenter"))
     
334.    ((= 8 Alignment) (setq Alignment "acAlignmentTopRight"))
     
335.    ((= 9 Alignment) (setq Alignment "acAlignmentMiddleLeft"))
     
336.    ((= 10 Alignment) (setq Alignment "acAlignmentMiddleCenter"))
     
337.    ((= 11 Alignment) (setq Alignment "acAlignmentMiddleRight"))
     
338.    ((= 12 Alignment) (setq Alignment "acAlignmentBottomLeft"))
     
339.    ((= 13 Alignment) (setq Alignment "acAlignmentBottomCenter"))
     
340.    ((= 14 Alignment) (setq Alignment "acAlignmentBottomRight"))
     
341.    (t (setq Alignment (rtos Alignment 2)))
     
342.    )
     
343.     (WRITE-LINE (strcat "   (gxl-AX:MakeStyle "" style "" 0.0 1 0 "" FontFile "" "" BigFontFile "")") OpenFile)
     
344.     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddText obj "" TextString "" \'" pt1 " " Height " " xz " " kb " " qx " " Alignment " "" style ""))") OpenFile)
     
345.     (if (/= Alignment "acAlignmentLeft") (WRITE-LINE (strcat "   (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" textaligmentpoint "))") OpenFile))
     
346.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
347.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
348.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
349.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
350.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
351.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
352.     )
     
353.    ((= "AcDbMText" ObjectName)
     
354.     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))
     
355.    Height (rtos (vla-get-Height obj) 2)
     
356.    xz (rtos (vla-get-Rotation obj) 2)
     
357.    Width (rtos (vla-get-width obj) 2)
     
358.    style (vla-get-StyleName obj)
     
359.    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)
     
360.    FontFile (vla-get-FontFile objTextStyle)
     
361.    BigFontFile (vla-get-BigFontFile objTextStyle)
     
362.    Font (strcat FontFile "," BigFontFile)
     
363.    styleHeight (rtos (vla-get-Height objTextStyle) 2)
     
364.    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)
     
365.    TextString (vla-get-TextString obj)
     
366.    La (vla-get-Layer obj)
     
367.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
368.    color (vla-get-color obj)
     
369.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
370.    AttachmentPoint (vla-get-AttachmentPoint obj)
     
371.    lineweight (rtos (vla-get-lineweight obj) 2)
     
372.    )
     
373.     (cond ((= 1 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopLeft"))
     
374.    ((= 2 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopCenter"))
     
375.    ((= 3 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopRight"))
     
376.    ((= 4 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleLeft"))
     
377.    ((= 5 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleCenter"))
     
378.    ((= 6 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleRight"))
     
379.    ((= 7 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomLeft"))
     
380.    ((= 8 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomCenter"))
     
381.    ((= 9 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomRight"))
     
382.    )
     
383.     (WRITE-LINE (strcat "   (gxl-AX:MakeStyle "" style "" 0.0 1 0  "" FontFile "" "" BigFontFile "")") OpenFile)
     
384.     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddMText obj "  "\'" pt1 " " Width " "" (substr (gxl-strunparse (GXL-STRPARSE TextString "\") "\\\") 2) "" " Height " " xz   " "" style ""))") OpenFile)
     
385.     (WRITE-LINE (strcat "   (vla-put-AttachmentPoint obj1 " AttachmentPoint ")") OpenFile)
     
386.     (WRITE-LINE (strcat "   (vla-put-InsertionPoint obj1 (vlax-3d-point \'" pt1 "))") OpenFile)
     
387.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
388.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
389.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
390.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
391.     )
     
392.    ((= "AcDbAttributeDefinition" ObjectName)
     
393.     (setq InsertionPoint (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))
     
394.    Height (rtos (vla-get-Height obj) 2)
     
395.    mode (vla-get-mode obj)
     
396.    $Prompt (vla-get-promptString obj)
     
397.    Tag (vla-get-TagString obj)
     
398.    Value (vla-get-TextString obj)
     
399.    Alignment (vla-get-alignment obj)
     
400.    style (vla-get-StyleName obj)
     
401.    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)
     
402.    FontFile (vla-get-FontFile objTextStyle)
     
403.    BigFontFile (vla-get-BigFontFile objTextStyle)
     
404.    Font (strcat FontFile "," BigFontFile)
     
405.    styleHeight (rtos (vla-get-Height objTextStyle) 2)
     
406.    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)
     
407.    kb (rtos (vla-get-ScaleFactor obj) 2)
     
408.    La (vla-get-Layer obj)
     
409.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
410.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
411.    color (vla-get-color obj)
     
412.    textaligmentpoint (GXL-STR-STOA (GXL-NUM-AX->LISPVALUE(vla-get-TextAlignmentPoint obj)))
     
413.    )
     
414.     (cond ((= 0 Alignment) (setq Alignment "acAlignmentLeft"))
     
415.    ((= 1 Alignment) (setq Alignment "acAlignmentCenter"))
     
416.    ((= 2 Alignment) (setq Alignment "acAlignmentRight"))
     
417.    ((= 3 Alignment) (setq Alignment "acAlignmentAligned"))
     
418.    ((= 4 Alignment) (setq Alignment "acAlignmentMiddle"))
     
419.    ((= 5 Alignment) (setq Alignment "acAlignmentFit"))
     
420.    ((= 6 Alignment) (setq Alignment "acAlignmentTopLeft"))
     
421.    ((= 7 Alignment) (setq Alignment "acAlignmentTopCenter"))
     
422.    ((= 8 Alignment) (setq Alignment "acAlignmentTopRight"))
     
423.    ((= 9 Alignment) (setq Alignment "acAlignmentMiddleLeft"))
     
424.    ((= 10 Alignment) (setq Alignment "acAlignmentMiddleCenter"))
     
425.    ((= 11 Alignment) (setq Alignment "acAlignmentMiddleRight"))
     
426.    ((= 12 Alignment) (setq Alignment "acAlignmentBottomLeft"))
     
427.    ((= 13 Alignment) (setq Alignment "acAlignmentBottomCenter"))
     
428.    ((= 14 Alignment) (setq Alignment "acAlignmentBottomRight"))
     
429.    (t (setq Alignment (rtos Alignment 2)))
     
430.    )
     
431.     (cond ((= 0 mode) (setq mode "acAttributeModeNormal"))
     
432.    ((= 1 mode) (setq mode "acAttributeModeInvisible"))
     
433.    ((= 2 mode) (setq mode "acAttributeModeConstant"))
     
434.    ((= 3 mode) (setq mode "acAttributeModeVerify"))
     
435.    ((= 4 mode) (setq mode "acAttributeModePreset"))
     
436.    (t (setq mode (rtos mode 2)))
     
437.    )
     
438.     (WRITE-LINE (strcat "   (gxl-MakeStyle "" style "" 0.0 1 0 1 "" FontFile "" "" BigFontFile "")") OpenFile)
     
439.     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDATT obj " Height " "  Mode " ""  $Prompt "" \'"  InsertionPoint " ""  Tag  "" """ "))") OpenFile)
     
440.     (WRITE-LINE (strcat "   (vla-put-ScaleFactor obj1 " kb ")") OpenFile)
     
441.            (WRITE-LINE (strcat "   (vla-put-alignment obj1 " Alignment ")") OpenFile)
     
442.            ;(WRITE-LINE (strcat "  (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" InsertionPoint "))") OpenFile)
     
443.     (if (/= Alignment "acAlignmentLeft") (WRITE-LINE (strcat "   (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" textaligmentpoint "))") OpenFile))
     
444.            (WRITE-LINE (strcat "   (vla-put-StyleName obj1 "" style "")") OpenFile)
     
445.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
446.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La "") " Plottable ")") OpenFile))
     
447.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
448.     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))
     
449.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
450.     )
     
451.    ((= "AcDbPoint" ObjectName)
     
452.     (setq InsertionPoint (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinates obj)))
     
453.    La (vla-get-Layer obj)
     
454.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
455.    color (vla-get-color obj)
     
456.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
457.    )
     
458.     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddPoint obj \'" InsertionPoint "))") OpenFile)
     
459.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
460.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
461.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
462.     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))
     
463.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
464.    
     
465.     )
     
466.    ((= "AcDbSolid" ObjectName)
     
467.     (setq P1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 0)))
     
468.    P2 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 1)))
     
469.    P3 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 2)))
     
470.    P4 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 3)))
     
471.    La (vla-get-Layer obj)
     
472.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
473.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
474.    color (vla-get-color obj)
     
475.    )
     
476.     (WRITE-LINE (strcat "(setq obj1 (gxl-AX:AddSolid obj \'" p1 " \'" p2 " \'" p3 " \'" p4 "))") OpenFile)
     
477.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
478.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
479.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
480.     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))
     
481.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)   
     
482.     )
     
483.    ((= "AcDbEllipse" ObjectName)
     
484.     (setq Center (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))
     
485.    MajorAxis (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-MajorAxis obj)))
     
486.    RadiusRatio (rtos (vla-get-RadiusRatio obj) 2)
     
487.    StartAngle (rtos (vla-get-StartAngle obj) 2)
     
488.    EndAngle (rtos (vla-get-endAngle obj) 2)
     
489.    La (vla-get-Layer obj)
     
490.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
491.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
492.    color (vla-get-color obj)
     
493.    lineType (vla-get-linetype obj)
     
494.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
495.    lineweight (rtos (vla-get-lineweight obj) 2)
     
496.    )
     
497.     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDELLIPSE obj \'" Center " \'"  MajorAxis " " RadiusRatio  "))") OpenFile)
     
498.     (WRITE-LINE (strcat "   (vla-put-StartAngle obj1 " StartAngle ")") OpenFile)
     
499.     (WRITE-LINE (strcat "   (vla-put-endAngle obj1 " EndAngle ")") OpenFile)
     
500.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
501.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
502.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
503.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
504.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
505.     (WRITE-LINE (strcat
     
506.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
507.     (WRITE-LINE (strcat
     
508.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
509.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
510.     (WRITE-LINE (strcat
     
511.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
512.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
513.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))
     
514.     )
     
515.            ((= "AcDbHatch" ObjectName)
     
516.     (setq PatternType (vla-get-PatternType obj)
     
517.    PatternName  (vla-get-PatternName obj)
     
518.    Associative (GXL-STR-STOA (vla-get-AssociativeHatch obj))
     
519.    NumberOfLoops (vla-get-NumberOfLoops obj)
     
520.    PatternScale (rtos (vla-get-PatternScale obj) 2)
     
521.    PatternAngle (rtos (vla-get-PatternAngle obj) 2)
     
522.    HatchStyle (vla-get-HatchStyle obj)
     
523.    HatchObjectType (vla-get-HatchObjectType obj)
     
524.    La (vla-get-Layer obj)
     
525.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
526.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
527.    color (vla-get-color obj)
     
528.    lineType (vla-get-linetype obj)
     
529.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
530.    lineweight (rtos (vla-get-lineweight obj) 2)
     
531.    )
     
532.     (if (/= 0 NumberOfLoops)
     
533.       (progn
     
534.     (cond ((= 0 PatternType) (setq PatternType "acHatchPatternTypePreDefined"))
     
535.    ((= 1 PatternType) (setq PatternType "acHatchPatternTypeUserDefined"))
     
536.    ((= 2 PatternType) (setq PatternType "acHatchPatternTypeCustomDefined"))
     
537.    )
     
538.     (cond ((= 0 HatchObjectType) (setq HatchObjectType "AcHatchObject"))
     
539.    ((= 1 HatchObjectType) (setq HatchObjectType "AcGradientObject"))
     
540.    )
     
541.     (cond ((= 0 HatchStyle) (setq HatchStyle "acHatchStyleNormal"))
     
542.    ((= 1 HatchStyle) (setq HatchStyle "acHatchStyleOuter"))
     
543.    ((= 2 HatchStyle) (setq HatchStyle "acHatchStyleIgnore"))
     
544.    )
     
545.     (setq Loops nil
     
546.    k 0)
     
547.     (repeat NumberOfLoops
     
548.       (vla-getloopat obj k 'OuterLoop)
     
549.       (setq Loops (append Loops (list OuterLoop)))
     
550.       (setq k (1+ k))
     
551.       )
     
552.     (setq k 0)
     
553.     (foreach Arays Loops
     
554.       (if (= (type Arays) 'safearray)
     
555.         (progn
     
556.    (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))
     
557.       (WRITE-LINE  "    (setq HatchobjAray nil)" OpenFile)
     
558.       (if (= k 0)
     
559.         (progn
     
560.    (WRITE-LINE (strcat "   (setq objHatch (vla-AddHatch obj " PatternType " "" PatternName "" " Associative " " HatchObjectType "))") OpenFile)
     
561.    (foreach HatchObj Arayl
     
562.      (MakeEntity HatchObj);此处嵌套调用容易溢出
     
563.      (WRITE-LINE  "(setq HatchobjAray (Append HatchobjAray (list obj1)))" OpenFile)
     
564.      )
     
565.    (WRITE-LINE  "(setq HatchobjAray (gxl-num-ObjList->AX:Array HatchobjAray))" OpenFile)
     
566.    ;(WRITE-LINE  "(vla-AppendOuterLoop objHatch HatchobjAray)" OpenFile)
     
567.    (WRITE-LINE "(setq axErr1 (VL-CATCH-ALL-APPLY \'vla-AppendOuterLoop (list objHatch HatchobjAray)))" OpenFile)
     
568.    );_ progn
     
569.         (progn
     
570.    (foreach HatchObj Arayl
     
571.      (MakeEntity HatchObj);此处嵌套调用容易溢出
     
572.      (WRITE-LINE  "(setq HatchobjAray (Append HatchobjAray (list obj1)))" OpenFile)
     
573.      )
     
574.    (WRITE-LINE  "(setq HatchobjAray (gxl-num-ObjList->AX:Array HatchobjAray))" OpenFile)
     
575.    ;(WRITE-LINE  "(vla-AppendInnerLoop objHatch HatchobjAray)" OpenFile)
     
576.    (WRITE-LINE "(setq axErr (VL-CATCH-ALL-APPLY \'vla-AppendInnerLoop (list objHatch HatchobjAray)))" OpenFile)
     
577.    );_ progn
     
578.         );_ if
     
579.       (setq k (1+ k))
     
580.       )
     
581.         )
     
582.       );_ foreach
     
583.     (WRITE-LINE   "   (if (not (VL-CATCH-ALL-ERROR-P axErr1))" OpenFile)
     
584.     (WRITE-LINE   "     (progn" OpenFile)
     
585.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
586.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
587.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
588.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer objHatch "" La "")") OpenFile))
     
589.     (WRITE-LINE (strcat "   (vla-put-color objHatch "" (itoa color) "")") OpenFile)
     
590.     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-layer objHatch "" lineweight "")") OpenFile))
     
591.     (WRITE-LINE (strcat
     
592.     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
593.     (WRITE-LINE (strcat
     
594.     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
595.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
596.     (WRITE-LINE (strcat
     
597.     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype objHatch "" lineType ""))") OpenFile)
     
598.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale objHatch " LineTypeScale ")") OpenFile)
     
599.     (WRITE-LINE (strcat "   (vla-put-PatternScale objHatch " PatternScale ")") OpenFile)
     
600.     (WRITE-LINE (strcat "   (vla-put-PatternAngle objHatch " PatternAngle ")") OpenFile)
     
601.     (WRITE-LINE (strcat "   (vla-put-HatchStyle objHatch " HatchStyle ")") OpenFile)
     
602.     (WRITE-LINE   "     )" OpenFile)
     
603.     (WRITE-LINE   "    )" OpenFile)
     
604.     );_ progn
     
605.       );_ if
     
606.     )
     
607.    ((= "AcDbBlockReference" ObjectName)
     
608.     ;(BlockLisp (vla-get-Name obj))
     
609.    
     
610.     (setq InsPt (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))
     
611.    BName (vla-get-Name obj)
     
612.    Xscale (rtos (vla-get-XScaleFactor obj) 2)
     
613.    Yscale (rtos (vla-get-YScaleFactor obj))
     
614.    Zscale (rtos (vla-get-ZScaleFactor obj))
     
615.    Rotation (rtos (vla-get-Rotation obj))
     
616.    La (vla-get-Layer obj)
     
617.    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))
     
618.    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))
     
619.    color (vla-get-color obj)
     
620.    lineType (vla-get-linetype obj)
     
621.    LineTypeScale (rtos (vla-get-LineTypeScale obj))
     
622.    )
     
623.    ; (WRITE-LINE (strcat "    (if (not (member ""  BName "" (gxl-table "block"))) (BlockLisp "" BName ""))") OpenFile)
     
624.     ;(BlockLisp BName)
     
625.      (WRITE-LINE (strcat "   (setq obj1 (vla-InsertBlock obj (vlax-3d-point \'"InsPt ") "" BName "" " Xscale " " Yscale " " ZScale " " Rotation "))") OpenFile)
     
626.     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))
     
627.     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)
     
628.     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))
     
629.     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))
     
630.     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)
     
631.     (WRITE-LINE (strcat
     
632.     "    (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)
     
633.     (WRITE-LINE (strcat
     
634.     "    (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""
     
635.     lineType "" "EstateCADTools.lin"))))") OpenFile)
     
636.     (WRITE-LINE (strcat
     
637.     "    (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)
     
638.     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)
     
639.     )
     
640.    (t nil)
     
641.    )
     
642.     )
     
643.   
     
644. ;;;图块定义
     
645.   (defun BlockLisp (blkName / EnObj Handle HatchEntList enObj ObjectName NumberOfLoops Loops k OuterLoop Arays Arayl a)
     
646.     ;(if (> (vla-get-Count (vla-Item (vla-get-Blocks *AcDocument*) blkName)) 0)
     
647.       (progn
     
648.    ;(WRITE-LINE (strcat " (if (not (member "" blkName ""( gxl-table "block")))") OpenFile)
     
649.    ;(WRITE-LINE  "  (progn" OpenFile)
     
650.    (WRITE-LINE   "   (setvar "clayer" "0")" OpenFile)
     
651.    (WRITE-LINE (strcat "   (setq obj (GXL-AX:ADDBLOCK \'(0 0 0) "" blkName ""))") OpenFile)
     
652.    ;;;遍历blkName，找出Hatch关联的边界实体的Handle，添加到表 HatchEntList 中
     
653.    (setq HatchEntList nil)
     
654.    ; 不支持 Hatch 实体，Hatch容易溢出
     
655.    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)
     
656.      (setq ObjectName (vla-get-ObjectName enObj)
     
657.    Handle (vla-get-Handle enObj)
     
658.    )
     
659.      (if (= "AcDbHatch" ObjectName)
     
660.        (progn
     
661.   (setq NumberOfLoops (vla-get-NumberOfLoops enObj))
     
662.   
     
663.     (setq Loops '()
     
664.    k 0)
     
665.     (repeat NumberOfLoops
     
666.       (vla-getloopat enObj k 'OuterLoop)
     
667.       (setq Loops (append Loops (list OuterLoop)))
     
668.       (setq k (1+ k))
     
669.       )
     
670.   (foreach Arays Loops
     
671.     ;;;问题出在这儿，溢出？(GXL-NUM-AX->LISPVALUE OuterLoop)
     
672.       (if (= (type Arays) 'safearray)
     
673.         (progn
     
674.    (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))
     
675.     (foreach a  Arayl (setq HatchEntList (cons (vla-get-handle a) HatchEntList))(setq a nil))
     
676.    )
     
677.         )
     
678.     )
     
679.   
     
680.   )
     
681.        )
     
682.      (setq enobj nil)
     
683.     )
     
684.    ;(setq HatchEntList nil)
     
685.   (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)
     
686.          
     
687.     (setq Handle (vla-get-Handle enObj))
     
688.    
     
689.      (if (not (member Handle HatchEntList)) (MakeEntity enObj))
     
690.     (setq enobj nil)
     
691.     )
     
692.    
     
693.   ;(WRITE-LINE "    )" OpenFile)
     
694.   ;(WRITE-LINE "   )" OpenFile)
     
695.   );_ progn
     
696.       ;);_ if
     
697. 
     
698.       )
     
699.   ;;;本函数添加了图块是否存在的判断
     
700.   (defun BlockLisp1 (blkName / EnObj Handle HatchEntList enObj ObjectName NumberOfLoops Loops k OuterLoop Arays Arayl a)
     
701.     ;(if (> (vla-get-Count (vla-Item (vla-get-Blocks *AcDocument*) blkName)) 0)
     
702.       (progn
     
703. ;;;添加图块是否存在判断语句
     
704.    (WRITE-LINE (strcat " (if (not (member "" blkName ""( gxl-table "block")))") OpenFile)
     
705.    (WRITE-LINE  "  (progn" OpenFile)
     
706.    (WRITE-LINE   "   (setvar "clayer" "0")" OpenFile)
     
707.    (WRITE-LINE (strcat "   (setq obj (GXL-AX:ADDBLOCK \'(0 0 0) "" blkName ""))") OpenFile)
     
708.       ;;;遍历blkName，找出Hatch关联的边界实体的Handle，添加到表 HatchEntList 中
     
709.    (setq HatchEntList nil)
     
710.    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)
     
711.      (setq ObjectName (vla-get-ObjectName enObj)
     
712.    Handle (vla-get-Handle enObj)
     
713.    )
     
714.      (if (= "AcDbHatch" ObjectName)
     
715.        (progn
     
716.   (setq NumberOfLoops (vla-get-NumberOfLoops enObj))
     
717.     (setq Loops '()
     
718.    k 0)
     
719.     (repeat NumberOfLoops
     
720.       (vla-getloopat enObj k 'OuterLoop)
     
721.       (setq Loops (append Loops (list OuterLoop)))
     
722.       (setq k (1+ k))
     
723.       )
     
724.   (foreach Arays Loops
     
725.     (if (= (type Arays) 'safearray)
     
726.       (progn
     
727.       (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))
     
728.     (foreach a  Arayl (setq HatchEntList (cons (vla-get-handle a) HatchEntList))(setq a nil))
     
729.       )
     
730.       )
     
731.     )
     
732.   
     
733.   )
     
734.        )
     
735.      (setq enobj nil)
     
736.     )
     
737.    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)
     
738.     (setq Handle (vla-get-Handle enObj))
     
739.     (if (not (member Handle HatchEntList)) (MakeEntity enObj))
     
740.      (setq enobj nil)
     
741.     )
     
742.    
     
743.   (WRITE-LINE "    )" OpenFile)
     
744.   (WRITE-LINE "   )" OpenFile)
     
745.   );_ progn
     
746.       ;);_ if
     
747. 
     
748.       )
     
749.   ;;;主程序
     
750.   ;(setierr)
     
751.   ;(setq OpenFile (open "MakeBlock.Lsp" "w"))
     
752.   (setq OpenFile (open (setq tmp_Fn (vl-filename-mktemp)) "w"))
     
753.   ;(setq enss (ssget "x" '((0 . "insert"))))
     
754.   ;;;剔除无名块
     
755.   (setq BlockNameList (VL-REMOVE-IF '(lambda (x) (= "*U" (substr x 1 2))) (vl-sort (GXL-TABLE "block") '<)))
     
756.   (if (not BlockNameList)(progn (alert "图形中没有图块可供生成代码！") (abcdefg)))
     
757.   (setq ;enss (GXL-SEL-SS->LIST enss)
     
758. mk 0
     
759. mn 0)
     
760.   ;(WRITE-LINE "(defun Create_block0 (Name / obj obj1)" OpenFile)
     
761.   ;(WRITE-LINE " (cond " OpenFile)
     
762.   (foreach blockName BlockNameList;enblk enss
     
763.     (setq blockName1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" blockName)))
     
764.      (WRITE-LINE (strcat "(defun MakeBlock-" blockName1 " (/ obj obj1 obj2 objHatch HatchobjAray )") OpenFile)
     
765.    ;;;列出嵌套子块，由低到高定义块实体
     
766.     (setq BL (ListMutiBlock blockName))
     
767.     (if bl (mapcar '(lambda (x) (BlockLisp1 x)) BL))
     
768.     ;;;定义非块实体
     
769.     (BlockLisp blockName)
     
770.     (WRITE-LINE "  )" OpenFile)
     
771.     );_ Foreach
     
772.   
     
773.   ;;;定义调用函数 gxl-Blk-Check
     
774.   ;|
     
775.   (WRITE-LINE "(defun gxl-Blk-Check (B_Name / curlay B_Name1)" OpenFile)
     
776.   (WRITE-LINE "  (setq B_Name1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" B_Name)))" OpenFile)
     
777.   (WRITE-LINE "  (setq curlay (getvar "Clayer"))" OpenFile)
     
778.   (WRITE-LINE "  (if (not (member B_Name (GXL-TABLE "block")))" OpenFile)
     
779.   (WRITE-LINE "    (progn" OpenFile)
     
780.   (WRITE-LINE "(if (or (= \'USUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))" OpenFile)
     
781.   (WRITE-LINE "        (= \'SUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))" OpenFile)
     
782.   (WRITE-LINE "      )" OpenFile)
     
783.   (WRITE-LINE "    (eval (read (strcat "(MakeBlock-" B_Name1 ")"))))" OpenFile)
     
784.   (WRITE-LINE "      )" OpenFile)
     
785.   (WRITE-LINE "    )" OpenFile)
     
786.   (WRITE-LINE "  (setvar "clayer" curlay)" OpenFile)
     
787.   (WRITE-LINE "  B_Name" OpenFile)
     
788.   (WRITE-LINE "  )" OpenFile)
     
789.   |;
     
790.     (close OpenFile)
     
791.   ;(startapp "notepad.exe" "MakeBlock.Lsp")
     
792.   (startapp "notepad.exe" tmp_Fn)
     
793.   ;(reerr)
     
794.   )
     
795. ;;; c:BlockIn 在图形中插入"E:\\lisp\\symbol"目录下的全部图形，
     
796. (defun c:BlockIn (/ f)
     
797.   (setierr)
     
798.   (foreach f (vl-sort (gxl-file-Dos_dir "E:\\lisp\\symbol\\*.dwg") '<)
     
799.     (command "-insert" (strcat "E:\\lisp\\symbol\" f) '(0 0 0) 1 1  0)
     
800.     )
     
801.   (reerr)
     
802.   )
     
803. ;;; gxl-Blk-Check 检查定义图块
     
804. (defun gxl-Blk-Check (B_Name / curlay B_Name1)
     
805.   (setq B_Name1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" B_Name)))
     
806.   (setq curlay (getvar "Clayer"))
     
807.   (if (not (member B_Name (GXL-TABLE "block")))
     
808.     (progn
     
809.       (if (or (= 'USUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))
     
810.        (= 'SUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))
     
811.        )
     
812. (eval (read (strcat "(MakeBlock-" B_Name1 ")"))))
     
813.       )
     
814.     )
     
815.   (setvar "clayer" curlay)
     
816.   B_Name
     
817.   )
     
818. 
     

<br /> ;;; gxl-Blk-Check 检查定义图块<br /> ;;;C:Block->Lisp1 由图块自动转为Lisp代码，可以处理嵌套块，但不能处理复杂的块<br /> ;;; c:BlockIn 在图形中插入某目录下的全部图形，<br /> ;;;******************************************************<br /> ;;;C:Block->Lisp1 由图块自动转为Lisp代码，可以处理嵌套块，但不能处理复杂的块<br /> (DEFUN C:BlockToLisp (/ ListMutiBlock       MakeEntity BlockLisp<br />    BlockLisp1 blkList    OpenFile  en<br />    ss    ss1       pt1  pt2<br />    R    Ang1       Ang2  mk<br />    mn    tmp_Fn     BlockName  BlockNameList<br />          ) ;_ /<br />   ;;;展开嵌套块中最基本图块单元，由低到高顺序<br /> (defun ListMutiBlock (BlockName / rtn listblkref blklst obj obj1 Bname)<br />   (defun listblkref (Name / objblk rtn1 obj2)<br />     (setq objblk (vla-item (vla-get-blocks *ACDOCUMENT*) Name)<br />    rtn1 (list Name))<br />   (vlax-for obj2 (vla-Item (vla-get-Blocks *AcDocument*) (vla-get-name objblk))<br />    (if (= "AcDbBlockReference" (vla-get-ObjectName obj2))<br />      (progn<br />        (setq Name (vla-get-Name obj2))<br />      ;(if (listblkref name) (setq rtn1 (append rtn1 (list (list name (listblkref name)))))(setq rtn1 (append (list name))))<br />      (setq rtn1 (append rtn1 (list  (listblkref name))))<br />      )<br />      )<br />     (setq obj2 nil)<br />    )<br />     (setq objblk nil)<br />     (gxl-ListDumpAtom rtn1)<br />   )<br />   (setq obj (vla-item (vla-get-blocks *ACDOCUMENT*) BlockName))<br />   (vlax-for obj1 obj<br />      (if (= "AcDbBlockReference" (vla-get-ObjectName obj1))<br />        (progn<br />   (setq  Bname (vla-get-Name obj1))<br />   ;(if (listblkref Bname) (setq rtn (append rtn (list (list Bname (listblkref Bname))))) (setq rtn (append (list Bname))))<br />      (setq rtn (append rtn  (list  (listblkref Bname))))<br />      )<br />    )<br />     (setq obj1 nil)<br />    )<br />   (setq obj nil)<br /> (setq rtn (gxl-RemoveItem nil (gxl-ListDumpAtom rtn)))<br />   (reverse (setq rtn (gxl-onelist rtn)))<br /> )<br />   ;;;块写实体,包含Hatch实体<br />   (defun MakeEntity (obj /        pt1      pt2<br />     La        Plottable     color<br />     LaColor       lineType      LineTypeScale<br />     R        pts      clo<br />     CONSTANTWIDTH StartTangent  EndTangent<br />     Height        xz      kb<br />     qx        Alignment     style<br />     objTextStyle  FontFile      BigFontFile<br />     Font        styleHeight   stylebliqueAngle<br />     styleScale    TextString    textaligmentpoint<br />     Width        AttachmentPoint<br />     InsertionPoint       mode<br />     $Prompt       Tag      Value<br />     P1        P2      P3<br />     P4        Center      MajorAxis<br />     RadiusRatio   StartAngle    EndAngle<br />     PatternType   PatternName   Associative<br />     NumberOfLoops PatternScale  PatternAngle<br />     HatchStyle    HatchObjectType<br />     InsPt        BName      Xscale<br />     Yscale        Zscale      Rotation<br />            lineweight<br />    ) ;_ obj<br />     (setq ObjectName (vla-get-ObjectName obj)<br />    Handle (vla-get-Handle obj)<br />    )<br />     (cond ((= "AcDbLine" ObjectName) <br />     (setq pt1 (GXL-STR-STOA (vlax-curve-getStartPoint obj))<br />    pt2 (GXL-STR-STOA (vlax-curve-getEndPoint obj))<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDLINE obj \'" pt1 " \'" pt2 "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "    (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbCircle" ObjectName)<br />     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))<br />    R (rtos (vla-get-radius obj) 2)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDCIRCLE obj \'" pt1 " " R "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbArc" ObjectName)<br />     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))<br />    R (rtos (vla-get-radius obj) 2)<br />    Ang1 (rtos (vla-get-StartAngle obj) 2)<br />    Ang2 (rtos (vla-get-endAngle obj) 2)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddArc obj \'" pt1 " "  R " "  Ang1 " "  Ang2 "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbPolyline" ObjectName)<br />     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-Coordinates obj)))<br />    bulges (cadr (GXL-GET_POLY_DATA obj))<br />    clo (vla-get-Closed obj)<br />    CONSTANTWIDTH (vla-get-ConstantWidth obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE<br />       (strcat<br />         "   (setq obj1 (vla-AddLightWeightPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "<br />         (itoa (length (read pts)))<br />         "))\'"<br />         pts<br />         "))))"<br />       ) ;_ strcat<br />       OpenFile<br />     ) ;_ WRITE-LINE<br />     (setq n 0)<br />     (foreach bulge bulges<br />       (if (/= bulge 0.0) (WRITE-LINE (strcat "  (vla-SetBulge obj1 " (itoa n) " " (rtos bulge 2) ")") OpenFile))<br />       (setq n (1+ n))<br />       )<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (if (= clo :vlax-true)<br />       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)<br />       )<br />     (if (not (equal CONSTANTWIDTH 0.0))<br />       (progn<br />         (setq CONSTANTWIDTH (rtos CONSTANTWIDTH 2))<br />         (WRITE-LINE  (strcat "   (vla-put-ConstantWidth obj1 " CONSTANTWIDTH ")") OpenFile)<br />         )<br />       )<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDb2dPolyline" ObjectName)<br />     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-Coordinates obj)))<br />    bulges (cadr (GXL-GET_POLY_DATA obj))<br />    clo (vla-get-Closed obj)<br />    CONSTANTWIDTH (vla-get-ConstantWidth obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE<br />       (strcat<br />         "   (setq obj1 (vla-AddPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "<br />         (itoa (length (read pts)))<br />         "))\'"<br />         pts<br />         "))))"<br />       ) ;_ strcat<br />       OpenFile<br />     ) ;_ WRITE-LINE<br />     (setq n 0)<br />     (foreach bulge bulges<br />       (if (/= bulge 0.0) (WRITE-LINE (strcat "  (vla-SetBulge obj1 " (itoa n) " " (rtos bulge 2) ")") OpenFile))<br />       (setq n (1+ n))<br />       )<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (if (= clo :vlax-true)<br />       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)<br />       )<br />     (if (not (equal CONSTANTWIDTH 0.0))<br />       (progn<br />         (setq CONSTANTWIDTH (rtos CONSTANTWIDTH 2))<br />         (WRITE-LINE  (strcat "   (vla-put-ConstantWidth obj1 " CONSTANTWIDTH ")") OpenFile)<br />         )<br />       )<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbSpline" ObjectName)<br />     (setq pts (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-FitPoints obj)))<br />    clo (vla-get-Closed obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    StartTangent (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-StartTangent obj)))<br />    EndTangent (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-endTangent obj)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE<br />       (strcat<br />         "   (setq obj1 (vla-AddSpline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 "<br />         (itoa (length (read pts)))<br />         "))\'"<br />         pts<br />         ")) (vlax-3d-point \'" StartTangent ") (vlax-3d-point \'" EndTangent ")))"<br />       ) ;_ strcat<br />       OpenFile<br />     ) ;_ WRITE-LINE<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (if (= clo :vlax-true)<br />       (WRITE-LINE  "   (vla-put-Closed obj1 :vlax-true)" OpenFile)<br />       )<br />     <br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbText" ObjectName)<br />     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))<br />    Height (rtos (vla-get-Height obj) 2)<br />    xz (rtos (vla-get-Rotation obj) 2)<br />    kb (rtos (vla-get-ScaleFactor obj) 2)<br />    qx (rtos (vla-get-ObliqueAngle obj) 2)<br />    Alignment (vla-get-alignment obj)<br />    style (vla-get-StyleName obj)<br />    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)<br />    FontFile (vla-get-FontFile objTextStyle)<br />    BigFontFile (vla-get-BigFontFile objTextStyle)<br />    Font (strcat FontFile "," BigFontFile)<br />    styleHeight (rtos (vla-get-Height objTextStyle) 2)<br />    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)<br />    ;styleScale (rtos (vla-get-ScaleFactor objTextStyle) 2)<br />    TextString (vla-get-TextString obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    textaligmentpoint (GXL-STR-STOA (GXL-NUM-AX->LISPVALUE(vla-get-TextAlignmentPoint obj)))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (cond ((= 0 Alignment) (setq Alignment "acAlignmentLeft"))<br />    ((= 1 Alignment) (setq Alignment "acAlignmentCenter"))<br />    ((= 2 Alignment) (setq Alignment "acAlignmentRight"))<br />    ((= 3 Alignment) (setq Alignment "acAlignmentAligned"))<br />    ((= 4 Alignment) (setq Alignment "acAlignmentMiddle"))<br />    ((= 5 Alignment) (setq Alignment "acAlignmentFit"))<br />    ((= 6 Alignment) (setq Alignment "acAlignmentTopLeft"))<br />    ((= 7 Alignment) (setq Alignment "acAlignmentTopCenter"))<br />    ((= 8 Alignment) (setq Alignment "acAlignmentTopRight"))<br />    ((= 9 Alignment) (setq Alignment "acAlignmentMiddleLeft"))<br />    ((= 10 Alignment) (setq Alignment "acAlignmentMiddleCenter"))<br />    ((= 11 Alignment) (setq Alignment "acAlignmentMiddleRight"))<br />    ((= 12 Alignment) (setq Alignment "acAlignmentBottomLeft"))<br />    ((= 13 Alignment) (setq Alignment "acAlignmentBottomCenter"))<br />    ((= 14 Alignment) (setq Alignment "acAlignmentBottomRight"))<br />    (t (setq Alignment (rtos Alignment 2)))<br />    )<br />     (WRITE-LINE (strcat "   (gxl-AX:MakeStyle "" style "" 0.0 1 0 "" FontFile "" "" BigFontFile "")") OpenFile)<br />     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddText obj "" TextString "" \'" pt1 " " Height " " xz " " kb " " qx " " Alignment " "" style ""))") OpenFile)<br />     (if (/= Alignment "acAlignmentLeft") (WRITE-LINE (strcat "   (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" textaligmentpoint "))") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />    ((= "AcDbMText" ObjectName)<br />     (setq pt1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))<br />    Height (rtos (vla-get-Height obj) 2)<br />    xz (rtos (vla-get-Rotation obj) 2)<br />    Width (rtos (vla-get-width obj) 2)<br />    style (vla-get-StyleName obj)<br />    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)<br />    FontFile (vla-get-FontFile objTextStyle)<br />    BigFontFile (vla-get-BigFontFile objTextStyle)<br />    Font (strcat FontFile "," BigFontFile)<br />    styleHeight (rtos (vla-get-Height objTextStyle) 2)<br />    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)<br />    TextString (vla-get-TextString obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    AttachmentPoint (vla-get-AttachmentPoint obj)<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (cond ((= 1 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopLeft"))<br />    ((= 2 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopCenter"))<br />    ((= 3 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointTopRight"))<br />    ((= 4 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleLeft"))<br />    ((= 5 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleCenter"))<br />    ((= 6 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointMiddleRight"))<br />    ((= 7 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomLeft"))<br />    ((= 8 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomCenter"))<br />    ((= 9 AttachmentPoint) (setq AttachmentPoint "acAttachmentPointBottomRight"))<br />    )<br />     (WRITE-LINE (strcat "   (gxl-AX:MakeStyle "" style "" 0.0 1 0  "" FontFile "" "" BigFontFile "")") OpenFile)<br />     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddMText obj "  "\'" pt1 " " Width " "" (substr (gxl-strunparse (GXL-STRPARSE TextString "\") "\\\") 2) "" " Height " " xz   " "" style ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-AttachmentPoint obj1 " AttachmentPoint ")") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-InsertionPoint obj1 (vlax-3d-point \'" pt1 "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     )<br />    ((= "AcDbAttributeDefinition" ObjectName)<br />     (setq InsertionPoint (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))<br />    Height (rtos (vla-get-Height obj) 2)<br />    mode (vla-get-mode obj)<br />    $Prompt (vla-get-promptString obj)<br />    Tag (vla-get-TagString obj)<br />    Value (vla-get-TextString obj)<br />    Alignment (vla-get-alignment obj)<br />    style (vla-get-StyleName obj)<br />    objTextStyle (vla-Item (vla-get-textstyles *AcDocument*) style)<br />    FontFile (vla-get-FontFile objTextStyle)<br />    BigFontFile (vla-get-BigFontFile objTextStyle)<br />    Font (strcat FontFile "," BigFontFile)<br />    styleHeight (rtos (vla-get-Height objTextStyle) 2)<br />    stylebliqueAngle (rtos (vla-get-ObliqueAngle objTextStyle)2)<br />    kb (rtos (vla-get-ScaleFactor obj) 2)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    textaligmentpoint (GXL-STR-STOA (GXL-NUM-AX->LISPVALUE(vla-get-TextAlignmentPoint obj)))<br />    )<br />     (cond ((= 0 Alignment) (setq Alignment "acAlignmentLeft"))<br />    ((= 1 Alignment) (setq Alignment "acAlignmentCenter"))<br />    ((= 2 Alignment) (setq Alignment "acAlignmentRight"))<br />    ((= 3 Alignment) (setq Alignment "acAlignmentAligned"))<br />    ((= 4 Alignment) (setq Alignment "acAlignmentMiddle"))<br />    ((= 5 Alignment) (setq Alignment "acAlignmentFit"))<br />    ((= 6 Alignment) (setq Alignment "acAlignmentTopLeft"))<br />    ((= 7 Alignment) (setq Alignment "acAlignmentTopCenter"))<br />    ((= 8 Alignment) (setq Alignment "acAlignmentTopRight"))<br />    ((= 9 Alignment) (setq Alignment "acAlignmentMiddleLeft"))<br />    ((= 10 Alignment) (setq Alignment "acAlignmentMiddleCenter"))<br />    ((= 11 Alignment) (setq Alignment "acAlignmentMiddleRight"))<br />    ((= 12 Alignment) (setq Alignment "acAlignmentBottomLeft"))<br />    ((= 13 Alignment) (setq Alignment "acAlignmentBottomCenter"))<br />    ((= 14 Alignment) (setq Alignment "acAlignmentBottomRight"))<br />    (t (setq Alignment (rtos Alignment 2)))<br />    )<br />     (cond ((= 0 mode) (setq mode "acAttributeModeNormal"))<br />    ((= 1 mode) (setq mode "acAttributeModeInvisible"))<br />    ((= 2 mode) (setq mode "acAttributeModeConstant"))<br />    ((= 3 mode) (setq mode "acAttributeModeVerify"))<br />    ((= 4 mode) (setq mode "acAttributeModePreset"))<br />    (t (setq mode (rtos mode 2)))<br />    )<br />     (WRITE-LINE (strcat "   (gxl-MakeStyle "" style "" 0.0 1 0 1 "" FontFile "" "" BigFontFile "")") OpenFile)<br />     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDATT obj " Height " "  Mode " ""  $Prompt "" \'"  InsertionPoint " ""  Tag  "" """ "))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-ScaleFactor obj1 " kb ")") OpenFile)<br />            (WRITE-LINE (strcat "   (vla-put-alignment obj1 " Alignment ")") OpenFile)<br />            ;(WRITE-LINE (strcat "  (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" InsertionPoint "))") OpenFile)<br />     (if (/= Alignment "acAlignmentLeft") (WRITE-LINE (strcat "   (vla-put-TextAlignmentPoint obj1 (vlax-3d-point \'" textaligmentpoint "))") OpenFile))<br />            (WRITE-LINE (strcat "   (vla-put-StyleName obj1 "" style "")") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La "") " Plottable ")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     )<br />    ((= "AcDbPoint" ObjectName)<br />     (setq InsertionPoint (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinates obj)))<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    color (vla-get-color obj)<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    )<br />     (WRITE-LINE (strcat "   (setq obj1 (gxl-AX:AddPoint obj \'" InsertionPoint "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     <br />     )<br />    ((= "AcDbSolid" ObjectName)<br />     (setq P1 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 0)))<br />    P2 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 1)))<br />    P3 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 2)))<br />    P4 (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-coordinate obj 3)))<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    )<br />     (WRITE-LINE (strcat "(setq obj1 (gxl-AX:AddSolid obj \'" p1 " \'" p2 " \'" p3 " \'" p4 "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La) (WRITE-LINE (strcat "   (vla-put-Layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)    <br />     )<br />    ((= "AcDbEllipse" ObjectName)<br />     (setq Center (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-center obj)))<br />    MajorAxis (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-MajorAxis obj)))<br />    RadiusRatio (rtos (vla-get-RadiusRatio obj) 2)<br />    StartAngle (rtos (vla-get-StartAngle obj) 2)<br />    EndAngle (rtos (vla-get-endAngle obj) 2)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (WRITE-LINE (strcat "   (setq obj1 (GXL-AX:ADDELLIPSE obj \'" Center " \'"  MajorAxis " " RadiusRatio  "))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-StartAngle obj1 " StartAngle ")") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-endAngle obj1 " EndAngle ")") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-lineweight obj1 "" lineweight "")") OpenFile))<br />     )<br />            ((= "AcDbHatch" ObjectName)<br />     (setq PatternType (vla-get-PatternType obj)<br />    PatternName  (vla-get-PatternName obj)<br />    Associative (GXL-STR-STOA (vla-get-AssociativeHatch obj))<br />    NumberOfLoops (vla-get-NumberOfLoops obj)<br />    PatternScale (rtos (vla-get-PatternScale obj) 2)<br />    PatternAngle (rtos (vla-get-PatternAngle obj) 2)<br />    HatchStyle (vla-get-HatchStyle obj)<br />    HatchObjectType (vla-get-HatchObjectType obj)<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    lineweight (rtos (vla-get-lineweight obj) 2)<br />    )<br />     (if (/= 0 NumberOfLoops)<br />       (progn<br />     (cond ((= 0 PatternType) (setq PatternType "acHatchPatternTypePreDefined"))<br />    ((= 1 PatternType) (setq PatternType "acHatchPatternTypeUserDefined"))<br />    ((= 2 PatternType) (setq PatternType "acHatchPatternTypeCustomDefined"))<br />    )<br />     (cond ((= 0 HatchObjectType) (setq HatchObjectType "AcHatchObject"))<br />    ((= 1 HatchObjectType) (setq HatchObjectType "AcGradientObject"))<br />    )<br />     (cond ((= 0 HatchStyle) (setq HatchStyle "acHatchStyleNormal"))<br />    ((= 1 HatchStyle) (setq HatchStyle "acHatchStyleOuter"))<br />    ((= 2 HatchStyle) (setq HatchStyle "acHatchStyleIgnore"))<br />    )<br />     (setq Loops nil<br />    k 0)<br />     (repeat NumberOfLoops<br />       (vla-getloopat obj k 'OuterLoop)<br />       (setq Loops (append Loops (list OuterLoop)))<br />       (setq k (1+ k))<br />       )<br />     (setq k 0)<br />     (foreach Arays Loops<br />       (if (= (type Arays) 'safearray)<br />         (progn<br />    (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))<br />       (WRITE-LINE  "    (setq HatchobjAray nil)" OpenFile)<br />       (if (= k 0)<br />         (progn<br />    (WRITE-LINE (strcat "   (setq objHatch (vla-AddHatch obj " PatternType " "" PatternName "" " Associative " " HatchObjectType "))") OpenFile)<br />    (foreach HatchObj Arayl<br />      (MakeEntity HatchObj);此处嵌套调用容易溢出<br />      (WRITE-LINE  "(setq HatchobjAray (Append HatchobjAray (list obj1)))" OpenFile)<br />      )<br />    (WRITE-LINE  "(setq HatchobjAray (gxl-num-ObjList->AX:Array HatchobjAray))" OpenFile)<br />    ;(WRITE-LINE  "(vla-AppendOuterLoop objHatch HatchobjAray)" OpenFile)<br />    (WRITE-LINE "(setq axErr1 (VL-CATCH-ALL-APPLY \'vla-AppendOuterLoop (list objHatch HatchobjAray)))" OpenFile)<br />    );_ progn<br />         (progn<br />    (foreach HatchObj Arayl<br />      (MakeEntity HatchObj);此处嵌套调用容易溢出<br />      (WRITE-LINE  "(setq HatchobjAray (Append HatchobjAray (list obj1)))" OpenFile)<br />      )<br />    (WRITE-LINE  "(setq HatchobjAray (gxl-num-ObjList->AX:Array HatchobjAray))" OpenFile)<br />    ;(WRITE-LINE  "(vla-AppendInnerLoop objHatch HatchobjAray)" OpenFile)<br />    (WRITE-LINE "(setq axErr (VL-CATCH-ALL-APPLY \'vla-AppendInnerLoop (list objHatch HatchobjAray)))" OpenFile)<br />    );_ progn<br />         );_ if<br />       (setq k (1+ k))<br />       )<br />         )<br />       );_ foreach<br />     (WRITE-LINE   "   (if (not (VL-CATCH-ALL-ERROR-P axErr1))" OpenFile)<br />     (WRITE-LINE   "     (progn" OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer objHatch "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color objHatch "" (itoa color) "")") OpenFile)<br />     (if (not(or (= "-1" lineweight)(= "-2" lineweight)(= "-3" lineweight))) (WRITE-LINE (strcat "   (vla-put-layer objHatch "" lineweight "")") OpenFile))<br />     (WRITE-LINE (strcat<br />     "   (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "   (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype objHatch "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale objHatch " LineTypeScale ")") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-PatternScale objHatch " PatternScale ")") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-PatternAngle objHatch " PatternAngle ")") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-HatchStyle objHatch " HatchStyle ")") OpenFile)<br />     (WRITE-LINE   "     )" OpenFile)<br />     (WRITE-LINE   "    )" OpenFile)<br />     );_ progn<br />       );_ if<br />     )<br />    ((= "AcDbBlockReference" ObjectName)<br />     ;(BlockLisp (vla-get-Name obj))<br />     <br />     (setq InsPt (GXL-STR-STOA (gxl-num-ax->lispvalue(vla-get-InsertionPoint obj)))<br />    BName (vla-get-Name obj)<br />    Xscale (rtos (vla-get-XScaleFactor obj) 2)<br />    Yscale (rtos (vla-get-YScaleFactor obj))<br />    Zscale (rtos (vla-get-ZScaleFactor obj))<br />    Rotation (rtos (vla-get-Rotation obj))<br />    La (vla-get-Layer obj)<br />    Plottable (GXL-STR-STOA (vla-get-Plottable (vla-Item (vla-get-layers *ACDOCUMENT*) La)))<br />    LaColor (vla-get-color (vla-item (vla-get-Layers *ACDOCUMENT*) La))<br />    color (vla-get-color obj)<br />    lineType (vla-get-linetype obj)<br />    LineTypeScale (rtos (vla-get-LineTypeScale obj))<br />    )<br />    ; (WRITE-LINE (strcat "    (if (not (member ""  BName "" (gxl-table "block"))) (BlockLisp "" BName ""))") OpenFile)<br />     ;(BlockLisp BName)<br />      (WRITE-LINE (strcat "   (setq obj1 (vla-InsertBlock obj (vlax-3d-point \'"InsPt ") "" BName "" " Xscale " " Yscale " " ZScale " " Rotation "))") OpenFile)<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (setq objLay (vla-add (vla-get-Layers *ACDOCUMENT*) "" La ""))") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") "" (itoa Lacolor) "")") OpenFile)<br />     (if (/= Plottable ":vlax-true")(WRITE-LINE (strcat "   (vla-put-Plottable (vla-item (vla-get-Layers *ACDOCUMENT*) "" La"") " Plottable ")") OpenFile))<br />     (if (/= "0" La)(WRITE-LINE (strcat "   (vla-put-layer obj1 "" La "")") OpenFile))<br />     (WRITE-LINE (strcat "   (vla-put-color obj1 "" (itoa color) "")") OpenFile)<br />     (WRITE-LINE (strcat<br />     "    (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "" lineType "" "acadiso.lin")))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "    (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY \'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) ""<br />     lineType "" "EstateCADTools.lin"))))") OpenFile)<br />     (WRITE-LINE (strcat<br />     "    (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "" lineType ""))") OpenFile)<br />     (WRITE-LINE (strcat "   (vla-put-LinetypeScale obj1 " LineTypeScale ")") OpenFile)<br />     )<br />    (t nil)<br />    )<br />     )<br />   <br /> ;;;图块定义<br />   (defun BlockLisp (blkName / EnObj Handle HatchEntList enObj ObjectName NumberOfLoops Loops k OuterLoop Arays Arayl a)<br />     ;(if (> (vla-get-Count (vla-Item (vla-get-Blocks *AcDocument*) blkName)) 0)<br />       (progn<br />    ;(WRITE-LINE (strcat " (if (not (member "" blkName ""( gxl-table "block")))") OpenFile)<br />    ;(WRITE-LINE  "  (progn" OpenFile)<br />    (WRITE-LINE   "   (setvar "clayer" "0")" OpenFile)<br />    (WRITE-LINE (strcat "   (setq obj (GXL-AX:ADDBLOCK \'(0 0 0) "" blkName ""))") OpenFile)<br />    ;;;遍历blkName，找出Hatch关联的边界实体的Handle，添加到表 HatchEntList 中<br />    (setq HatchEntList nil)<br />    ; 不支持 Hatch 实体，Hatch容易溢出<br />    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)<br />      (setq ObjectName (vla-get-ObjectName enObj)<br />    Handle (vla-get-Handle enObj)<br />    )<br />      (if (= "AcDbHatch" ObjectName)<br />        (progn<br />   (setq NumberOfLoops (vla-get-NumberOfLoops enObj))<br />   <br />     (setq Loops '()<br />    k 0)<br />     (repeat NumberOfLoops<br />       (vla-getloopat enObj k 'OuterLoop)<br />       (setq Loops (append Loops (list OuterLoop)))<br />       (setq k (1+ k))<br />       )<br />   (foreach Arays Loops<br />     ;;;问题出在这儿，溢出？(GXL-NUM-AX->LISPVALUE OuterLoop)<br />       (if (= (type Arays) 'safearray)<br />         (progn<br />    (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))<br />     (foreach a  Arayl (setq HatchEntList (cons (vla-get-handle a) HatchEntList))(setq a nil))<br />    )<br />         )<br />     )<br />   <br />   )<br />        )<br />      (setq enobj nil)<br />     )<br />    ;(setq HatchEntList nil)<br />   (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)<br />           <br />     (setq Handle (vla-get-Handle enObj))<br />     <br />      (if (not (member Handle HatchEntList)) (MakeEntity enObj))<br />     (setq enobj nil)<br />     )<br />    <br />   ;(WRITE-LINE "    )" OpenFile)<br />   ;(WRITE-LINE "   )" OpenFile)<br />   );_ progn<br />       ;);_ if<br /> <br />       )<br />   ;;;本函数添加了图块是否存在的判断<br />   (defun BlockLisp1 (blkName / EnObj Handle HatchEntList enObj ObjectName NumberOfLoops Loops k OuterLoop Arays Arayl a)<br />     ;(if (> (vla-get-Count (vla-Item (vla-get-Blocks *AcDocument*) blkName)) 0)<br />       (progn<br /> ;;;添加图块是否存在判断语句<br />    (WRITE-LINE (strcat " (if (not (member "" blkName ""( gxl-table "block")))") OpenFile)<br />    (WRITE-LINE  "  (progn" OpenFile)<br />    (WRITE-LINE   "   (setvar "clayer" "0")" OpenFile)<br />    (WRITE-LINE (strcat "   (setq obj (GXL-AX:ADDBLOCK \'(0 0 0) "" blkName ""))") OpenFile)<br />       ;;;遍历blkName，找出Hatch关联的边界实体的Handle，添加到表 HatchEntList 中<br />    (setq HatchEntList nil)<br />    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)<br />      (setq ObjectName (vla-get-ObjectName enObj)<br />    Handle (vla-get-Handle enObj)<br />    )<br />      (if (= "AcDbHatch" ObjectName)<br />        (progn<br />   (setq NumberOfLoops (vla-get-NumberOfLoops enObj))<br />     (setq Loops '()<br />    k 0)<br />     (repeat NumberOfLoops<br />       (vla-getloopat enObj k 'OuterLoop)<br />       (setq Loops (append Loops (list OuterLoop)))<br />       (setq k (1+ k))<br />       )<br />   (foreach Arays Loops<br />     (if (= (type Arays) 'safearray)<br />       (progn<br />       (setq Arayl (GXL-NUM-AX->LISPVALUE Arays))<br />     (foreach a  Arayl (setq HatchEntList (cons (vla-get-handle a) HatchEntList))(setq a nil))<br />       )<br />       )<br />     )<br />   <br />   )<br />        )<br />      (setq enobj nil)<br />     )<br />    (vlax-for enObj (vla-Item (vla-get-Blocks *AcDocument*) blkName)<br />     (setq Handle (vla-get-Handle enObj))<br />     (if (not (member Handle HatchEntList)) (MakeEntity enObj))<br />      (setq enobj nil)<br />     )<br />    <br />   (WRITE-LINE "    )" OpenFile)<br />   (WRITE-LINE "   )" OpenFile)<br />   );_ progn<br />       ;);_ if<br /> <br />       )<br />   ;;;主程序<br />   ;(setierr)<br />   ;(setq OpenFile (open "MakeBlock.Lsp" "w"))<br />   (setq OpenFile (open (setq tmp_Fn (vl-filename-mktemp)) "w"))<br />   ;(setq enss (ssget "x" '((0 . "insert"))))<br />   ;;;剔除无名块<br />   (setq BlockNameList (VL-REMOVE-IF '(lambda (x) (= "*U" (substr x 1 2))) (vl-sort (GXL-TABLE "block") '<)))<br />   (if (not BlockNameList)(progn (alert "图形中没有图块可供生成代码！") (abcdefg)))<br />   (setq ;enss (GXL-SEL-SS->LIST enss)<br /> mk 0<br /> mn 0)<br />   ;(WRITE-LINE "(defun Create_block0 (Name / obj obj1)" OpenFile)<br />   ;(WRITE-LINE " (cond " OpenFile)<br />   (foreach blockName BlockNameList;enblk enss<br />     (setq blockName1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" blockName)))<br />      (WRITE-LINE (strcat "(defun MakeBlock-" blockName1 " (/ obj obj1 obj2 objHatch HatchobjAray )") OpenFile)<br />    ;;;列出嵌套子块，由低到高定义块实体<br />     (setq BL (ListMutiBlock blockName))<br />     (if bl (mapcar '(lambda (x) (BlockLisp1 x)) BL))<br />     ;;;定义非块实体<br />     (BlockLisp blockName)<br />     (WRITE-LINE "  )" OpenFile)<br />     );_ Foreach<br />   <br />   ;;;定义调用函数 gxl-Blk-Check<br />   ;|<br />   (WRITE-LINE "(defun gxl-Blk-Check (B_Name / curlay B_Name1)" OpenFile)<br />   (WRITE-LINE "  (setq B_Name1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" B_Name)))" OpenFile)<br />   (WRITE-LINE "  (setq curlay (getvar "Clayer"))" OpenFile)<br />   (WRITE-LINE "  (if (not (member B_Name (GXL-TABLE "block")))" OpenFile)<br />   (WRITE-LINE "    (progn" OpenFile)<br />   (WRITE-LINE "(if (or (= \'USUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))" OpenFile)<br />   (WRITE-LINE "        (= \'SUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))" OpenFile)<br />   (WRITE-LINE "      )" OpenFile)<br />   (WRITE-LINE "    (eval (read (strcat "(MakeBlock-" B_Name1 ")"))))" OpenFile)<br />   (WRITE-LINE "      )" OpenFile)<br />   (WRITE-LINE "    )" OpenFile)<br />   (WRITE-LINE "  (setvar "clayer" curlay)" OpenFile)<br />   (WRITE-LINE "  B_Name" OpenFile)<br />   (WRITE-LINE "  )" OpenFile)<br />   |;<br />     (close OpenFile)<br />   ;(startapp "notepad.exe" "MakeBlock.Lsp")<br />   (startapp "notepad.exe" tmp_Fn)<br />   ;(reerr)<br />   )<br /> ;;; c:BlockIn 在图形中插入"E:\\lisp\\symbol"目录下的全部图形，<br /> (defun c:BlockIn (/ f)<br />   (setierr)<br />   (foreach f (vl-sort (gxl-file-Dos_dir "E:\\lisp\\symbol\\*.dwg") '<)<br />     (command "-insert" (strcat "E:\\lisp\\symbol\" f) '(0 0 0) 1 1  0)<br />     )<br />   (reerr)<br />   )<br /> ;;; gxl-Blk-Check 检查定义图块<br /> (defun gxl-Blk-Check (B_Name / curlay B_Name1)<br />   (setq B_Name1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" B_Name)))<br />   (setq curlay (getvar "Clayer"))<br />   (if (not (member B_Name (GXL-TABLE "block")))<br />     (progn<br />       (if (or (= 'USUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))<br />        (= 'SUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))<br />        )<br /> (eval (read (strcat "(MakeBlock-" B_Name1 ")"))))<br />       )<br />     )<br />   (setvar "clayer" curlay)<br />   B_Name<br />   )<br /> <br />

代码中涉及到一些自定义公用函数，需要前贴中附件打包的函数支持！

578749467

看起来是很神奇的