cj52000 发表于 2009-8-25 20:26:00

[求助]求画引线孔的lisp程序？

<p>各位好，一般模板腔体线割时需画出引线孔，求能框选一个或多个封闭多段线，提示引线孔直径，然后画出引线孔的lisp程序，谢谢！</p>

ljttjl 发表于 2009-8-25 20:44:00

<p>上传个cad例图，举个例子看看。</p>

sieben 发表于 2009-8-26 17:09:00

<p>我有画穿线孔的程序,要就联系我或留下你的联系方式</p><p>QQ:812928665</p><p>Email:sieben@sina.com</p>

cj52000 发表于 2009-8-27 01:26:00

<p>谢谢楼上的兄弟，我邮箱是<a href="mailto:chenjian520@139.com">chenjian520@139.com</a>,能否传我一份，谢谢！</p>

AMTONNY 发表于 2009-8-30 00:06:00

<p>楼主看看以下代码是否你所求</p><p>(defun c:ab (/ ss r i minpt maxpt p)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (prompt "\n快速建立中点,请框选对象")<br/>&nbsp; (if (and (setq ss (ssget))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq r 0.1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; (repeat (setq i (sslength ss))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq i (1- i) a (vlax-ename-&gt;vla-object (ssname ss i)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vla-getboundingbox a 'minpt 'maxpt)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray-&gt;list (list minpt maxpt)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>)<br/></p>

cj52000 发表于 2009-8-30 15:00:00

<p>啊，谢谢<strong><font face="Verdana" color="#61b713">AMTONNY兄，正合我意，经常在论坛上看到AMTONNY兄发的程序都是很实用的，再次感谢！</font></strong></p>

AMTONNY 发表于 2009-9-3 23:39:00

呵呵，本人只是个菜鸟，只能针对菜鸟发一点实用的东东，对大师级人物来说可是不屑一顾的小玩意哟

墨者 发表于 2018-4-14 23:21:50

谢谢AMTONNY大师的分享
页: [1]
查看完整版本: [求助]求画引线孔的lisp程序？