请高手看我这个个提取指定线长的程序哪有问题

forestgxc

在这个程序中要提取所有>=2000的直线,

可是总是有线不能从选择集中一次性删除,需要重复运行几次

哪位高手帮忙看一下

(defun test ()
  (setq s1 (ssget))   ;获取选择集
  (setq count -1)

  (while
    (< count (1- (sslength s1)))
     (progn
       (setq count (1+ count))
       (setq s1_name (ssname s1 count))
       (setq s1_data (entget s1_name))
     ;求直线长度
       (setq dis
       (distance
  (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标
  (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标
       )
       )
     ;判断是否小于2000,如果小于2000则从s1中删除
       (if (< dis 2000)
  (ssdel s1_name s1)
       )

     )
  )
  (sssetfirst nil s1)

)

caoyin

(defun test ()
  (setq s1 (ssget))   ;获取选择集
  (setq count (sslength s1))
  (while (>= (setq count (1- count)) 0)
    (setq s1_name (ssname s1 count))
    (setq s1_data (entget s1_name))
    ;求直线长度
    (setq dis
       (distance
  (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标
  (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标
       )
       )
     ;判断是否小于2000,如果小于2000则从s1中删除
       (if (< dis 2000)
  (ssdel s1_name s1)
       )
  )
  (sssetfirst nil s1)
)

;;建议repeat替代while

(defun test ()
  (setq s1 (ssget))   ;获取选择集
  (repeat (setq count (sslength s1))
    (setq count   (1- count)
          s1_name (ssname s1 count)
          s1_data (entget s1_name)
          dis     (distance
                    (cdr (assoc 10 s1_data)) ;起点串行 cdr起点坐标
                    (cdr (assoc 11 s1_data)) ;终点串行 cdr终点坐标
                  )
    )
    (if (< dis 2000)
      (ssdel s1_name s1)
    )
  )
  (sssetfirst nil s1)
)

ZZXXQQ

forestgxc发表于2008-8-24 10:17:00在这个程序中要提取所有>=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中数量减少，循环基数改变。
下面是改过的程序

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

sailorcwx

2. (defun c:test(/ ACADAPP ACADDOC SSET)
3.   (vl-load-com)
4.   (setq acadapp (vlax-get-acad-object)
5. acaddoc (vla-get-activedocument acadapp)
6. )
7.   (if (ssget '((0 . "LINE")))
8.     (progn
9.       (setq sset (vla-get-activeselectionset acaddoc))
10.       (vlax-for obj sset
11. (if (< (vla-get-length obj) 2000)(vla-erase obj))
12. )
13.       )
14.     )
15.   (princ)
16.   )

(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)   )

forestgxc

二楼的可以实现

三楼的贴子暂时看不到,哈哈:)

四楼的也可以实现,不过删掉了小于2000的线,不希望看到这样的结果,不过同样谢谢(vla的函数还没学,非常简洁)

forestgxc

只是暂时还没搞明白while函数错在什么地方?

sailorcwx

看错了，我以为你要删小于2000的线

sailorcwx

有两个地方错,都是由于(ssdel s1_name s1)引起的,在遍历选择集的时候不要对选择集进行增减操作

程序在运行的过程中,由于(ssdel s1_name s1)将选集内的元素逐渐删除,(sslength s1)的值实际在不断变小,而count在不断变大,在满足了(< count (1- (sslength s1)))后循环退出,而这时候实际上这时候并未遍历完选集,有遗漏的问题

另外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跳过了

解决的办法可以在循环前增加一个新选集s2,在循环中把满足条件的图元添加到选集s2中,循环过后再把s2里面的图元删除

forestgxc

此问题已经得到圆满解决,谢谢各位,谢谢!

88888888

ffffffffffffffff