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

比较上的2个实体列表

你好
 
我想比较多段线实体列表和圆实体列表:
 
如果多段线端点垂直XY坐标与圆心坐标XY匹配。
然后将圆的层名称写入新列表。
 
如果不匹配,则返回“不匹配”
 
 
我已经有了一个子例程,可以获取LWpolyline的(开始)顶点。
在重复中尝试重复。。。但那没有成功。
所以我在这里被绊住了,跟mapcar lambda成员有什么关系?
 
有人能帮我比较两个列表吗
 
格里茨,
 
格本

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

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

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

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

(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

我的尝试。
 

(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绘图员在修改过程中可能会移动一些圆),例程应终止并发出警报。
 
我对您的代码进行了一些修改,以显示我想要的:
 
(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

像这样的?

(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任何端点上的圆形对象?
页: [1] 2
查看完整版本: 比较上的2个实体列表