社区 › Auto Lisp › 比较两条多段线

Andresig 发表于 2022-7-6 12:01:30

比较两条多段线

我需要比较两条多段线，看看它们的尺寸是否相同。
这两条多段线位于不同的坐标中。
 
VBA中是否有执行此操作的“命令”？
 
我的猜测是提取长度、角度和凸起，然后进行比较，但必须是一种更简单的方法。。。
 
如果有人能帮我，我将不胜感激！

eldon 发表于 2022-7-6 12:15:41

 
在不使用任何编码的情况下，能否复制一条多段线并将其放置在另一条多段线的顶部，然后进行目视检查？

David Bethel 发表于 2022-7-6 12:21:37

这应该适用于2条重多段线：
 

(defun c:arepleq (/ ss pl1 pl2 vn1 vn2 vd1 vd2
                      vl1 vl2 bl1 bl2 delta)
(while (or (not ss)
            (/= (sslength ss) 2))
      (princ "\nSelect 2 Polylines To Compare:   ")
      (setq ss (ssget '((0 . "POLYLINE")))))

(setq pl1 (ssname ss 0)
       pl2 (ssname ss 1)
       vn1 (entnext pl1)
       vn2 (entnext pl2))

(while (/= "SEQEND" (cdr (assoc 0 (entget vn1))))
      (setq vd1 (entget vn1)
            vl1 (cons (cdr (assoc 10 vd1)) vl1)
            bl1 (cons (cdr (assoc 42 vd1)) bl1)
            vn1 (entnext vn1)))

(while (/= "SEQEND" (cdr (assoc 0 (entget vn2))))
      (setq vd2 (entget vn2)
            vl2 (cons (cdr (assoc 10 vd2)) vl2)
            bl2 (cons (cdr (assoc 42 vd2)) bl2)
            vn2 (entnext vn2)))

(if (= (length bl1) (length bl2))
   (progn
      (setq delta (mapcar '- (car vl1) (car vl2)))
      (while (and vl1 vl2 delta)
               (cond ((equal delta (mapcar '- (car vl1) (car vl2)) 1e-8)
                      (setq vl1 (cdr vl1)
                            vl2 (cdr vl2)))
                     (T (setq delta nil))))
      (foreach p bl1
         (if (not (equal (car bl1) (car bl2) 1e-8))
               (setq delta nil))
         (setq bl1 (cdr bl1)
               bl2 (cdr bl2)))))

(if delta
    (alert "Polylines vertices and bulges are offsets")
    (alert "Polylines vertices and bulges are not offsets"))

(prin1))

-大卫

Lee Mac 发表于 2022-7-6 12:28:07

好代码David

David Bethel 发表于 2022-7-6 12:33:29

 
 
谢谢它可能需要在ssget调用中进行更多过滤，并处理LWpolyline，但我今天有点懒，必须去看牙医-大卫

Lee Mac 发表于 2022-7-6 12:45:51

 
而不是你而不是我！：眨眼：

gile 发表于 2022-7-6 12:51:16

你好
 
我的2个字母表示多段线。
 
(defun comparepline (pl1 pl2 / el1 el2 pt1 pt2 sw1 sw2 ew1 ew2 bu1 bu2 vec)
(mapcar
   '(lambda (pl el pt sw ew bu)
      (set el (entget pl))
      (foreach p (eval el)
      (cond
          ((= 10 (car p)) (set pt (cons (cdr p) (eval pt))))
          ((= 40 (car p)) (set sw (cons (cdr p) (eval sw))))
          ((= 41 (car p)) (set ew (cons (cdr p) (eval ew))))
          ((= 42 (car p)) (set bu (cons (cdr p) (eval bu))))
      )
      )
    )
   (list pl1 pl2)
   '(el1 el2)
   '(pt1 pt2)
   '(sw1 sw2)
   '(ew1 ew2)
   '(bu1 bu2)
)
(setq vec (mapcar '- (car pt1) (car pt2)))
(and
   (equal sw1 sw2)
   (equal ew1 ew2)
   (equal bu1 bu2)
   (equal pt1 (mapcar '(lambda (p) (mapcar '+ p vec)) pt2))
)
)

Lee Mac 发表于 2022-7-6 12:57:07

吉尔，
 
我喜欢你获取凸起/点等列表的方法——非常新颖！

Andresig 发表于 2022-7-6 13:04:24

效果很好！
谢谢David&Gile

查看完整版本: 比较两条多段线