请高手看我这个个提取指定线长的程序哪有问题
<p>在这个程序中要提取所有>=2000的直线,</p><p>可是总是有线不能从选择集中一次性删除,需要重复运行几次</p><p>哪位高手帮忙看一下</p><p></p><p></p><p></p><p>(defun test ()<br/> (setq s1 (ssget)) ;获取选择集<br/> (setq count -1)</p><p> (while<br/> (< count (1- (sslength s1)))<br/> (progn<br/> (setq count (1+ count))<br/> (setq s1_name (ssname s1 count))<br/> (setq s1_data (entget s1_name))<br/> ;求直线长度<br/> (setq dis<br/> (distance<br/> (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标<br/> (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标<br/> )<br/> )<br/> ;判断是否小于2000,如果小于2000则从s1中删除<br/> (if (< dis 2000)<br/> (ssdel s1_name s1)<br/> )</p><p> )<br/> )<br/> (sssetfirst nil s1)</p><p>)</p><p></p><p></p> 本帖最后由 作者 于 2008-8-24 11:24:23 编辑 <br /><br /> <p>(defun test ()<br/> (setq s1 (ssget)) ;获取选择集<br/> (setq count (sslength s1))<br/> (while (>= (setq count (1- count)) 0)<br/> (setq s1_name (ssname s1 count))<br/> (setq s1_data (entget s1_name))<br/> ;求直线长度<br/> (setq dis<br/> (distance<br/> (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标<br/> (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标<br/> )<br/> )<br/> ;判断是否小于2000,如果小于2000则从s1中删除<br/> (if (< dis 2000)<br/> (ssdel s1_name s1)<br/> )<br/> )<br/> (sssetfirst nil s1)<br/>)</p><p>;;建议repeat替代while</p><p>(defun test ()<br/> (setq s1 (ssget)) ;获取选择集<br/> (repeat (setq count (sslength s1))<br/> (setq count (1- count)<br/> s1_name (ssname s1 count)<br/> s1_data (entget s1_name)<br/> dis (distance<br/> (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标<br/> (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标<br/> )<br/> )<br/> (if (< dis 2000)<br/> (ssdel s1_name s1)<br/> )<br/> )<br/> (sssetfirst nil s1)<br/>)</p> 本帖最后由 作者 于 2008-8-26 19:33:48 编辑forestgxc发表于2008-8-24 10:17:00static/image/common/back.gif在这个程序中要提取所有>=2000的直线,可是总是有线不能从选择集中一次性删除,需要重复运行几次哪位高手帮忙看一下(defun test ()(setq s1 (ssget)) ;获取选择集&nb注意：(if (< dis 2000) (ssdel s1_name sl))不起任何作用，不能改变选择集sl。
如果上句改成(if (< dis 2000) (setq sl (ssdel s1_name sl)))可以改动选择集sl，但选择集sl中数量减少，循环基数改变。
下面是改过的程序
(defun test ()
(if (setq s1 (ssget '((0 . "LINE")))) (progn ;这里加入过滤符使选择集只能是直线
(setq i -1 sdel (ssadd))
(repet (sslength s1)
(setq s1_name (ssname s1 (setq i (1+ i))))
(setq s1_data (entget s1_name))
(setq dis (distance (cdr (assoc 10 s1_data)) (cdr (assoc 11 s1_data))))
(if (< dis 2000) (setq sdel (ssadd s1_name sdel))) ;构造不符合要求的选择集
)
(if (> (sslength sdel) 0) (progn
(setq i 0)
(repeat (sslength sdel)
(setq sl (ssdel (ssnamd sdel i) sl) i (1+ i)) ;删除不符合要求的选择
)
))
(sssetfirst sl)
))
)
(defun c:test(/ ACADAPP ACADDOC SSET)
(vl-load-com)
(setq acadapp (vlax-get-acad-object)
acaddoc (vla-get-activedocument acadapp)
)
(if (ssget '((0 . "LINE")))
(progn
(setq sset (vla-get-activeselectionset acaddoc))
(vlax-for obj sset
(if (< (vla-get-length obj) 2000)(vla-erase obj))
)
)
)
(princ)
)
<p>二楼的可以实现</p><p></p><p>三楼的贴子暂时看不到,哈哈:)</p><p>四楼的也可以实现,不过删掉了小于2000的线,不希望看到这样的结果,不过同样谢谢(vla的函数还没学,非常简洁)</p> 只是暂时还没搞明白while函数错在什么地方? <p>看错了，我以为你要删小于2000的线</p> <p>有两个地方错,都是由于(ssdel s1_name s1)引起的,在遍历选择集的时候不要对选择集进行增减操作</p><p>程序在运行的过程中,由于(ssdel s1_name s1)将选集内的元素逐渐删除,(sslength s1)的值实际在不断变小,而count在不断变大,在满足了(< count (1- (sslength s1)))后循环退出,而这时候实际上这时候并未遍历完选集,有遗漏的问题</p><p>另外ssname也会因为选集内的元素被删除而出现错误.比如count=0的时候,s1={a b c d},而你的程序满足删除条件执行了(ssdel s1_name s1)后,删掉了a,这个时候ss1={b c d},循环后count=1,这个时候(setq s1_name (ssname s1 count))选到的就是c,而把b跳过了</p><p>解决的办法可以在循环前增加一个新选集s2,在循环中把满足条件的图元添加到选集s2中,循环过后再把s2里面的图元删除</p> 此问题已经得到圆满解决,谢谢各位,谢谢! ffffffffffffffff
页:
[1]