MSasu 发表于 2022-7-6 09:37:47

筛选0条长度线

我正在尝试设计一个例程，将清理所有0长度线的绘图；第一次尝试是创建一个包含所有行的选择集，并对其进行解析，以比较起点和终点（DXF代码10和11）。不幸的是，这是一个很长的过程。
可以为SSGET函数编写过滤器，以仅选择具有相同DXF代码10和11的行？
非常感谢。
 
当做
米尔恰

Lee Mac 发表于 2022-7-6 09:43:49

我不确定这是否可行，因为如果使用“-4”关系过滤代码，10和11 DXF组码需要有值进行比较：
 
由于直线图元没有表示长度的DXF代码，因此没有唯一的值来过滤。。。
 
这是我最有可能遵循的路线：
 

(defun c:test ( / ss i e l )

(if (setq ss (ssget "_X" '((0 . "LINE"))))
   (repeat (setq i (sslength ss))
   (setq e (ssname ss (setq i (1- i)))
         l (entget e)
   )      
   (if (equal (cdr (assoc 10 l)) (cdr (assoc 11 l)) 1e- (entdel e))
   )
)
(princ)
)

Tharwat 发表于 2022-7-6 09:47:07

没有人能比李更快。
 
这就是我可怜的方式。
 
(defun c:TesT (/ sel ss i sset 1st 2nd obj)
(setq sel (ssadd))
(setq ss (ssget "_x" '((0 . "LINE"))))
(repeat
   (setq i (sslength ss))
    (while
      (setq sset (ssname ss (setq i (1- i))))
       (setq 1st (cdr (assoc 10 (setq ents (entget sset)))))
       (setq 2nd (cdr (assoc 11 ents)))
       (if (and (eq (car 1st) (car 2nd))
                (eq (cadr 1st) (cadr 2nd))
         )
         (setq obj (ssadd sset sel))
       )
    )
)
(sssetfirst nil obj)
(print (strcat (itoa (sslength obj)) " " " Line(s) found"))
(princ)
)

 
塔瓦特

pBe 发表于 2022-7-6 09:49:18

弗拉怎么办？

Lee Mac 发表于 2022-7-6 09:53:06

 
请注意，您的代码有一个嵌套循环，因此，在遍历内部while循环相当于选择集大小的次数后，它将以相同的次数遍历repeat循环。

pBe 发表于 2022-7-6 09:56:45


(defun c:test (/ sset)(vl-load-com)
(if (setq sset (ssget "X" '((0 . "LINE"))))
   (progn(foreach
      ob (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
   (if (/= (vla-get-length (vlax-ename->vla-object ob)) 0.0)
       (setq sset (ssdel ob sset))
       )
   )
   (sssetfirst nil sset)
   )
   )
)

alanjt 发表于 2022-7-6 09:57:08

糟糕、糟糕、低效。

pBe 发表于 2022-7-6 10:00:11

 
 
（ssget“_：L”'（（0。“行”））
（对象的vlax（setq ss（vla get activeselectionset adoc））。。。。
 
较好的

alanjt 发表于 2022-7-6 10:04:15

很或者用repeat/while单步执行，并使用 (vlax-curve-getDistAtParam <Entity> (vlax-curve-getEndParam <Entity>))
您还可以使用vlax curve getDistAtPoint和vlax curve getEndPoint。两者都可以。

Tharwat 发表于 2022-7-6 10:06:57

 
非常感谢。
 
所以While函数对于repeat是错误的。
 
 
我喜欢lambda。
 

(defun c:TesT (/ sel ss)
(setq sel (ssadd))
(if (setq ss (ssget "_x" '((0 . "LINE"))))
   ((lambda (i / sset 1st 2nd obj)
      (while
      (setq sset (ssname ss (setq i (1+ i))))
         (setq 1st (cdr (assoc 10 (setq ents (entget sset)))))
         (setq 2nd (cdr (assoc 11 ents)))
         (if (and (eq (car 1st) (car 2nd))
                  (eq (cadr 1st) (cadr 2nd))
             )
         (setq obj (ssadd sset sel))
         )
      )
      (sssetfirst nil obj)
    )
   -1
   )
)
(princ)
)
页: [1] 2
查看完整版本: 筛选0条长度线