比较上的2个实体列表

gsc · 发表于 2022-7-5 16:02:02

你好

我想比较多段线实体列表和圆实体列表：

如果多段线端点垂直XY坐标与圆心坐标XY匹配。
然后将圆的层名称写入新列表。

如果不匹配，则返回“不匹配”

我已经有了一个子例程，可以获取LWpolyline的（开始）顶点。
在重复中尝试重复。。。但那没有成功。
所以我在这里被绊住了，跟mapcar lambda成员有什么关系？

有人能帮我比较两个列表吗

格里茨，

格本

Tharwat · 发表于 2022-7-5 16:10:56

你能写下这两个列表吗？或者你是在选择了多段线和圆来检查它们的坐标之后？

需要更多的信息。

Aftertouch · 发表于 2022-7-5 16:11:50

下面的代码允许您选择多段线。
然后检查其端点上是否有圆。
如果是这样，则将圆移动到图层MATCHLAYER。

copy


(defun C:CadTutor ( / polyline polylinex polyliney allcircles n ensel enlist circlex circley)
(setq polyline (entget (car (entsel))))
(setq polylinex (car (cdr (assoc 10 (reverse polyline)))))
(setq polyliney (car (cddr (assoc 10 (reverse polyline)))))
(setq allcircles (ssget "_X" (list (cons 0 "CIRCLE"))))
(setq n (sslength allcircles))
(repeat n
        (setq ensel (ssname allcircles (setq n (1- n)))) 
        (setq enlist (entget ensel))
        (setq circlex (car (cdr (assoc 10 enlist))))
        (setq circley (car (cdr (cdr (assoc 10 enlist)))))
        (if (and (= polylinex circlex)(= polyliney circley))
                (progn
                        (princ "\nMatch found!")
                        (setq enlist (subst (cons 8 "MATCHLAYER") (assoc 8 enlist) enlist))
                        (entmod enlist)
                )
                (progn
                        (princ "\nNo match...")
                )
        )
)
(princ)
)

Tharwat · 发表于 2022-7-5 16:18:48

我的尝试。

copy


(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017        ;;
 (if (and (or (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
              (alert "Couldn't find any circle in this drawing <!>")
              )
          (progn
            (while (setq ent (ssname sel (setq int (1+ int))))
              (setq lst (cons (list ent (cdr (assoc 10 (entget ent)))) lst))
              )
            lst
            )
          (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
          (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
          )
   (while (setq ent (ssname sel (setq int (1+ int))))
     (vl-some '(lambda (p)
                 (if (or (equal (vlax-curve-getstartpoint ent) (cadr p) 1e-4)
                         (equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                         )
                   (entmod (append (entget (car p)) '((8 . "MatchLayer"))))))
              lst)
     )
   )
 (princ)
 ) (vl-load-com)

Tharwat · 发表于 2022-7-5 16:20:55

注：如果起点和终点上有两个圆，则只需将函数vl some替换为mapcar。

gsc · 发表于 2022-7-5 16:26:59

Thanx man，你的代码工作顺利，但它并不完全是我想要的。
我将其更改为我想要实现的目标：

变化：
所有圆都在不同的层中
因为所有圆都在（或应该在）多段线端点上
我想要一个条件，即如果任何LWPOLYLINE端点等于任何圆的中心点，则将圆图层名称写入列表。
但如果不相等，则例程必须终止并发出警报，因为CAD绘图员在修改过程中可能会移动x个圆。

“WHILE VL-SOME LAMBDA IF”循环将1个多段线端点与所有选定的圆中心点进行比较。。。如果我错了，请纠正我，如果选择了77个圆，76个圆不等于当前的LWPOLYLINE端点。但是，其他76个圆可能与其他多段线端点匹配。

这可能吗？

gsc · 发表于 2022-7-5 16:33:26

嗨，塔瓦，

你的代码运行平稳，但这并不完全是我想要的。
我画的所有圆圈都在不同的图层上
此外，所有圆都（或应该）位于LWD多段线端点上（因此目前我不需要起点）。
如果这是真的，则必须将圆层名称写入列表。
但您的While循环将1个多段线端点与所有圆的中心点进行比较。
因此，如果假设集合中有77个圆，其中76个与循环中当前LWPOLYLINE端点的端点不匹配。
但是，它们确实与其他多段线端点匹配。
我想要实现的是，如果任何LWPOLYLINE端点与任何圆中心点匹配，则将圆图层名称写入列表
如果不是，则x数量的圆不位于LWD多段线端点上（CAD绘图员在修改过程中可能会移动一些圆），例程应终止并发出警报。

我对您的代码进行了一些修改，以显示我想要的：

copy

(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017    ;;
           
     (setq ss2_list nil)
   (setq wtg_id2_lst nil)
   (if 
       (and
           (or
               (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
           (alert "Couldn't find any circle in this drawing <!>")
           )
           (progn
               (while (setq ent (ssname sel (setq int (1+ int))))
                   (setq ss2_list (cons (list ent (cdr (assoc 10 (entget ent)))) ss2_list))
               )
               ss2_list
           )
           
           (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
           (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       )
       (while (setq ent (ssname sel (setq int (1+ int))))
           (vl-some '(lambda (p)
               (cond ((equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           (setq wtg_id2_lst (cons (cdr (assoc 8 (entget (car p)))) wtg_id2_lst))
                       )
                       ((/= (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           
                           ; All circles are (or should be) on endpoints of LWPOLYLINES
                           ; So If any circle is not on any LWPOLYLINE endpoint then break the routine with an alert
                       )
               )
           )
           ss2_list)
       )
   )
   (princ)
)
(vl-load-com)

Tharwat · 发表于 2022-7-5 16:38:24

像这样的？

copy


(defun c:Test ( / int sel ent lst fnd obj lys)
 ;; Tharwat - Date: 11.Sep.2017    ;;
   (if (and (or (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
                (alert "Couldn't find any circle in this drawing <!>")
                )
           (progn
               (while (setq ent (ssname sel (setq int (1+ int))))
                   (setq lst (cons (list ent (cdr (assoc 10 (entget ent)))) lst))
               )
               lst
             )
           (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
           (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       )
       (while (and (not fnd) (setq ent (ssname sel (setq int (1+ int)))))
          (if (vl-some '(lambda (o) (and (equal (vlax-curve-getendpoint ent) (cadr o) 1e-4) (setq obj o))) lst)
             (setq lys (cons (cdr (assoc 8 (entget (car obj)))) lys))
                 (progn
                   (setq fnd t)
                   (alert "Found a circle not reside on any end point of a LWpolyline <!>")
                   )
            )
         )
     )
   lys
) (vl-load-com)

gsc · 发表于 2022-7-5 16:42:49

哇，很有魅力！thanx公司

关于它的几个问题：
代码中的（非fnd）和（setq fnd t）是什么？当我在它们前面加分号时，仍然得到相同的结果
2.while语句后的lst和if语句后的lys是否相同？

gsc · 发表于 2022-7-5 16:45:13

是否可以在变量中捕捉不在LWDOLYLINE任何端点上的圆形对象？

[编程交流] 比较上的2个实体列表

发表回复

精选推荐