看起来是很神奇的
好牛啊，看来路还长
hpy发表于2010-8-9 13:23:00static/image/common/back.gif如果能支持高版本的CAD就更好了。
<p>测试了2008版本，可以正常运行！</p>
<p>只能纯欣赏了!</p>
<p>感谢楼主分享!</p>
<p>试着运行了依稀，生成的代码如下，但就是不知道怎样使用？</p>
<p><font face="Verdana">(defun MakeBlock-jt (/ obj obj1 obj2 objHatch HatchobjAray )<br/> (setvar "clayer" "0")<br/> (setq obj (GXL-AX:ADDBLOCK '(0 0 0) "jt"))<br/> (setq obj1 (GXL-AX:ADDLINE obj '(-1.0 0.0 0.0) '(1.0 0.0 0.0)))<br/> (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "0") "7")<br/> (vla-put-color obj1 "256")<br/> (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "acadiso.lin")))<br/> (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "EstateCADTools.lin"))))<br/> (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "ByLayer"))<br/> (vla-put-LinetypeScale obj1 1)<br/> (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)))))<br/> (vla-put-color (vla-item (vla-get-Layers *ACDOCUMENT*) "0") "7")<br/> (vla-put-color obj1 "256")<br/> (vla-put-ConstantWidth obj1 0.45)<br/> (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "acadiso.lin")))<br/> (if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes *ACDOCUMENT*) "ByLayer" "EstateCADTools.lin"))))<br/> (if (not (VL-CATCH-ALL-ERROR-P axErr)) (vla-put-linetype obj1 "ByLayer"))<br/> (vla-put-LinetypeScale obj1 1)<br/> )<br/></font></p>
yfywk发表于2010-9-5 17:35:00static/image/common/back.gif试着运行了依稀，生成的代码如下，但就是不知道怎样使用？
(defun MakeBlock-jt (/ obj obj1 obj2 objHatch HatchobjAray ) ...
<p>请仔细阅读一楼的帖子！</p>
<p>这个工具很强大啊！</p>
可惜不是源码只能欣赏了。盼楼主分享源码。或转繁体谢谢！
本帖最后由 Gu_xl 于 2012-3-16 20:00 编辑
应大家的要求，现将源码公布如下，供大家共同交流：
**** Hidden Message *****代码中涉及到一些自定义公用函数，需要前贴中附件打包的函数支持！
看起来是很神奇的