求能查找最近孔并显示出来的lisp?谢谢
<p></p><p>有附图,请帮忙,谢谢</p><p>想求一个能够把会破孔的圆孔按边到边距离为0.254为准的那些圆用透明圈显示出来,以备修改用,谢谢</p><p>"0-0"距离小于0.254mm 圈出</p><p>"0-0"距离大于0.254mm不理会</p><p>请各位高手们解决!!!</p> <p>这是显示最后画的圆。</p><p>(DEFUN C:TT ()<br/> (IF (SETQ SS (SSGET '((0 . "CIRCLE"))))<br/> (REDRAW (SSNAME SS 0) 3)<br/> )<br/> (PRINC)<br/>)</p> <p>程序试用:只能选两个圆,不论多远都会选中一个,呵%%</p><p>能不能调为在众多的圆中找出圆的边到圆小于0.254的圆显示出来呢</p><p>就是无论有多少对这样的小于0.254的距离的圆都选中.希望能帮忙修改</p> 请哪位老大帮忙完成这个功能??谢谢 <p>先试试这个</p><p>(DEFUN C:TEST ()<br/> (IF (SETQ SS (SSGET '((0 . "CIRCLE"))))<br/> (PROGN<br/> (setq i -1<br/> k 0<br/> n 0<br/> )<br/> (while (setq ent1 (ssname ss (setq i (1+ i))))<br/>;;;取选集第1个图元<br/> (while (setq ent2 (ssname ss (setq k (1+ k))))<br/>;;;取选集第2个图元，如果有继续<br/> (progn<br/> (setq obj1 (vlax-ename->vla-object ent1)<br/> obj2 (vlax-ename->vla-object ent2)<br/> )<br/> (setq r1 (vla-get-Radius obj1)<br/> r2 (vla-get-Radius obj2)<br/> cen1 (vlax-get obj1 'center)<br/> cen2 (vlax-get obj2 'center)<br/> )<br/> (setq d (distance cen1 cen2))<br/> (setq L (- d (+ r1 r2)))<br/> (if (and (<= L 0.254)(> L 0)) <br/> (progn<br/> (REDRAW ent2 3)<br/> (setq n 1)<br/> )<br/> )<br/> )<br/> )<br/> (setq k (1+ i))<br/> (if (= n 1)<br/> (progn<br/> (REDRAW ent1 3)<br/> (setq n 0)<br/> )<br/> )<br/> )<br/> )<br/> )<br/>)</p><p><br/></p> 本帖最后由 作者 于 2008-11-15 15:12:51 编辑 <br /><br /> <p><strong><font face="Verdana" color="#61b713">ljpnb谢谢你的帮忙,程序可以应用,就是要这种效果.不过如果能将选出来的圆移到新的层或者用其它颜色来表达就好看多了,因为现在所选的如果多的话很难分辨,希望ljpnb能帮忙,谢谢</font></strong></p><p>如果能在每个有破孔的所显示的地方作一个标识哽好,如:数学或字母</p>(DEFUN C:TEST ()
(if (not (tblobjname "layer" "临时"));;;;创建一个"临时"图层
(entmake
(list '(0 . "LAYER") ;_类型名称,不用改
'(100 . "AcDbSymbolTableRecord") ;_不可少
'(100 . "AcDbLayerTableRecord") ;_不可少
(cons 2 "临时") ;_图层名
'(70 . 0)
(cons 62 2) ;颜色
(cons 6 "CONTINUOUS")
;;线型
)
)
)
(IF (SETQ SS (SSGET '((0 . "CIRCLE"))))
(PROGN
(setq i -1
k 0
n nil
m 0
)
(while (setq ent1 (ssname ss (setq i (1+ i))))
;;;取选集第1个图元
(while (setq ent2 (ssname ss (setq k (1+ k))))
;;;取选集第2个图元，如果有继续
(progn
(setq obj1 (vlax-ename->vla-object ent1)
obj2 (vlax-ename->vla-object ent2)
)
(setq r1 (vla-get-Radius obj1)
r2 (vla-get-Radius obj2)
cen1 (vlax-get obj1 'center)
cen2 (vlax-get obj2 'center)
)
(setq d (distance cen1 cen2))
(setq L (- d (+ r1 r2)))
(if (and (<= L 0.254) (> L 0))
(progn
(vla-put-layer obj2 "临时");;;;移到"临时"图层
(setq n T)
(setq m (1+ m))
)
)
)
)
(setq k (1+ i))
(if n
(progn
(vla-put-layer obj1 "临时");;;;移到"临时"图层
(setq n nil)
(setq m (1+ m))
)
)
)
)
)
(if (= m 0);;;如果没有找到符合条件的物体,则删除"临时"图层
(progn
(setq lay (vlax-ename->vla-object (tblobjname "layer" "临时")))
(vla-delete lay)
)
)
(princ (strcat "\n共有" (rtos m 2) "个物体需要修改"))
(princ)
)
<p>非常感谢,<strong><font face="Verdana" color="#61b713">ljpnb</font></strong></p><p>呵&&&孔多的时候.程序好慢,晕死了 不知有没办法省去上些没必要的??就是说大于0.5距离的快速跳过</p><p></p>
页:
[1]