求平面全等直线段封闭多边形最佳算法

x_s_s_1 · 发表于 2023-3-23 09:23

本帖最后由 x_s_s_1 于 2023-3-23 14:51 编辑

本人几何水平及算法水平有限，写了一个求平面全等直线段封闭多边形的函数，用的是全部边角相等则全等的定理，感觉速度很慢，而且不是最佳算法。哪位能加个测速函数更好，谢谢。
下面是我写的函数
在我的电脑上92边形用时3869毫秒；四边形2902毫秒；自交四边形2949毫秒。

;;;=============================================
;;; 通用函数全等多边形
;;;参数：en---------基准型
;;; enlst------图元表
;;;返回值：(全等表)
(defun xty-get-eqpl (en enlst fuzz / mirr_x
append_sas eq_list lst1 lst2
lst3 sasl1 sasl2
)
;;;单位向量
(defun vec-unit (v / dis)
(setq dis (distance v '(0 0 0)))
(cond ((= 1. dis) v)
((> dis 1e-14) (mapcar '(lambda (n) (* n (/ 1.0 dis))) v))
((equal 0. dis 1e-14) nil)
)
)
;;;内积
(defun vec-Dot (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;;;Y轴镜像表
(defun mirr_x (ptl)
(mapcar '(lambda (x) (mapcar '* '(-1 1 1) x)) ptl)
)
;;;判断点列表是否顺时针方向
(defun Clockwise-p (lst)
(minusp
(apply '+
(mapcar
(function
(lambda (a b)
(- (* (car b) (cadr a)) (* (car a) (cadr b)))
)
)
lst
(cons (last lst) lst)
)
)
)
)
;;;形成反向sa表(边角 ... 边角)，为效率，未reverse
(defun append_sas (lst / a b lst1 lst2 lst3 lst4)
(setq a (list (car lst))
b (list (cadr lst))
lst1 (append lst a)
lst2 (mapcar 'distance lst (cdr lst1))
lst (append lst1 b)
)
(setq lst3 (mapcar '(lambda (x y) (vec-unit (mapcar '- y x)))
lst1
(cdr lst)
)
lst3 (mapcar '(lambda (v1 v2) (vec-Dot v1 v2))
lst3
(cdr lst3)
)
)
(while lst2
(setq lst4 (cons (car lst2) lst4)
lst2 (cdr lst2)
lst4 (cons (car lst3) lst4)
lst3 (cdr lst3)
)
)
lst4
)
;;;两等长sa表对比
(defun eq_list (lst1 lst2 fuzz / i n oi)
(setq n (* 0.5 (length lst1))
i 0
)
(while (< i n)
(if (vl-position
'nil
(mapcar '(lambda (x y) (equal x y fuzz)) lst1 lst2)
)
(setq lst2 (append (cddr lst2) (list (car lst2) (cadr lst2)))
i (1+ i)
oi nil
)
(setq oi t
i n
)
)
)
oi
)
;;;获取lwpline点表
(defun get-plptlist (en /)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
)
)
(setq lst1 (get-plptlist en)
lst1 (if (Clockwise-p lst1)
lst1
(reverse lst1)
)
sasl1 (append_sas lst1)
)
(foreach n enlst
(setq lst2 (get-plptlist n)
lst2 (if (Clockwise-p lst2)
lst2
(reverse lst2)
)
sasl2 (append_sas lst2)
)
(if (eq_list sasl1 sasl2 fuzz)
(setq lst3 (cons n lst3))
(progn (setq lst2 (mirr_x lst2)
lst2 (if (Clockwise-p lst2)
lst2
(reverse lst2)
)
sasl2 (append_sas lst2)
)
(if (eq_list sasl1 sasl2 fuzz)
(setq lst3 (cons n lst3))
)
)
)
)
lst3
)
(defun xty-tr-ss2lst (ss form / n en lst)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq lst (cons en lst))
)
(setq lst (reverse lst))
(if form
lst
(mapcar (function vlax-ename->vla-object) lst)
)
)
(defun xty-put-dxf (en code ch / ent)
(setq ent (entget en))
(if (assoc code ent)
(entmod (subst (cons code ch) (assoc code ent) ent))
(entmod (append ent (list (cons code ch))))
)
(entupd en)
)
(defun c:tt (/ en ss time)
(setq en (car (entsel"\n拾取基准型:"))
ss (ssget)
ss (xty-tr-ss2lst ss t)
)
(setq time (getvar "millisecs"))
(foreach n (xty-get-eqpl en ss 1e-6) (xty-put-dxf n 62 1))
(setq time (- (getvar "millisecs") time))
(print (strcat "经历时间为：" (itoa time) "毫秒"))
)

;;;============================================= 
;;;      通用函数  全等多边形 
;;;参数：en---------基准型 
;;;      enlst------图元表 
;;;返回值：(全等表) 
(defun xty-get-eqpl (en        enlst    fuzz  /   mirr_x 
         append_sas         eq_list  lst1   lst2 
         lst3     sasl1    sasl2 
         ) 
;;;单位向量 
  (defun vec-unit (v / dis) 
    (setq dis (distance v '(0 0 0))) 
    (cond ((= 1. dis) v) 
    ((> dis 1e-14) (mapcar '(lambda (n) (* n (/ 1.0 dis))) v)) 
    ((equal 0. dis 1e-14) nil) 
    ) 
    ) 
;;;内积 
  (defun vec-Dot (v1 v2) 
    (apply '+ (mapcar '* v1 v2)) 
    ) 
;;;Y轴镜像表 
  (defun mirr_x  (ptl) 
    (mapcar '(lambda (x) (mapcar '* '(-1 1 1) x)) ptl) 
    ) 
;;;判断点列表是否顺时针方向 
  (defun Clockwise-p (lst) 
    (minusp 
      (apply '+ 
       (mapcar 
         (function 
     (lambda (a b) 
       (- (* (car b) (cadr a)) (* (car a) (cadr b))) 
       ) 
     ) 
         lst 
         (cons (last lst) lst) 
         ) 
       ) 
      ) 
    ) 
 
;;;形成反向sa表(边 角 ... 边 角)，为效率，未reverse 
  (defun append_sas (lst / a b lst1 lst2 lst3 lst4) 
    (setq a    (list (car lst)) 
    b    (list (cadr lst)) 
    lst1 (append lst a) 
    lst2 (mapcar 'distance lst (cdr lst1)) 
    lst  (append lst1 b) 
    ) 
    (setq lst3 (mapcar '(lambda (x y) (vec-unit (mapcar '- y x))) 
           lst1 
           (cdr lst) 
           ) 
    lst3 (mapcar '(lambda (v1 v2) (vec-Dot v1 v2)) 
           lst3 
           (cdr lst3) 
           ) 
    ) 
    (while lst2 
      (setq lst4 (cons (car lst2) lst4) 
      lst2 (cdr lst2) 
      lst4 (cons (car lst3) lst4) 
      lst3 (cdr lst3) 
      ) 
      ) 
    lst4 
    ) 
;;;两等长sa表对比 
  (defun eq_list (lst1 lst2 fuzz / i n oi) 
    (setq n (* 0.5 (length lst1)) 
    i 0 
    ) 
    (while (
      (if (vl-position 
      'nil 
      (mapcar '(lambda (x y) (equal x y fuzz)) lst1 lst2) 
      ) 
  (setq lst2 (append (cddr lst2) (list (car lst2) (cadr lst2))) 
        i     (1+ i) 
        oi   nil 
        ) 
  (setq oi t 
        i   n 
        ) 
  ) 
      ) 
    oi 
    ) 
;;;获取lwpline点表 
  (defun get-plptlist (en /) 
    (mapcar 'cdr 
      (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en)) 
      ) 
    ) 
  (setq  lst1  (get-plptlist en) 
  lst1  (if (Clockwise-p lst1) 
    lst1 
    (reverse lst1) 
    ) 
  sasl1 (append_sas lst1) 
  ) 
  (foreach n enlst 
    (setq lst2  (get-plptlist n) 
    lst2  (if (Clockwise-p lst2) 
      lst2 
      (reverse lst2) 
      ) 
    sasl2  (append_sas lst2) 
    ) 
    (if  (eq_list sasl1 sasl2 fuzz) 
      (setq lst3 (cons n lst3)) 
      (progn (setq lst2   (mirr_x lst2) 
       lst2   (if (Clockwise-p lst2) 
         lst2 
         (reverse lst2) 
         ) 
       sasl2 (append_sas lst2) 
       ) 
       (if (eq_list sasl1 sasl2 fuzz) 
         (setq lst3 (cons n lst3)) 
         ) 
       ) 
      ) 
    ) 
  lst3 
  ) 
(defun xty-tr-ss2lst (ss form / n en lst) 
  (repeat (setq n (sslength ss)) 
    (setq en (ssname ss (setq n (1- n)))) 
    (setq lst (cons en lst)) 
    ) 
  (setq lst (reverse lst)) 
  (if form 
    lst 
    (mapcar (function vlax-ename->vla-object) lst) 
    ) 
  ) 
(defun xty-put-dxf (en code ch / ent) 
  (setq ent (entget en)) 
  (if (assoc code ent) 
    (entmod (subst (cons code ch) (assoc code ent) ent)) 
    (entmod (append ent (list (cons code ch)))) 
    ) 
  (entupd en) 
  ) 
(defun c:tt (/ en ss time) 
  (setq    en (car (entsel"\n拾取基准型:")) 
    ss (ssget) 
    ss (xty-tr-ss2lst ss t) 
    ) 
  (setq time (getvar "millisecs")) 
  (foreach n (xty-get-eqpl en ss 1e-6) (xty-put-dxf n 62 1)) 
  (setq time (- (getvar "millisecs") time)) 
  (print (strcat "经历时间为：" (itoa time) "毫秒")) 
  )

下面是测试图形

mahuan1279 · 发表于 2023-3-23 11:44

平移、旋转、镜像。

xtjd · 发表于 2023-3-23 12:20

(defun c:t2 (/ en ss time xtjd-test xtjd-test2)
  (defun xtjd-test(en ss fuzz / s)
(defun get(o)(list(length(vlax-get o 'Coordinates))(vla-get-Length o)(vla-get-area o)))
(setq  s(get(vlax-ename->vla-object en)))
(vl-remove-if-not(function(lambda(x)(equal s(get x)fuzz)))(mapcar 'vlax-ename->vla-object(ss->ens ss)))
  )
  (defun xtjd-test2(o)(vla-put-color o 1))
  (setq en(car(entsel"\n拾取基准型:"))ss(ssget))
  (setq time (getvar "millisecs"))
  (mapcar 'xtjd-test2(xtjd-test en ss 1e-6))
  (setq time (- (getvar "millisecs") time))
  (print (strcat "经历时间为：" (itoa time) "毫秒"))
)

x_s_s_1 · 发表于 2023-3-23 13:06

xtjd 发表于 2023-3-23 12:20
(defun c:t2 (/ en ss time xtjd-test xtjd-test2)
(defun xtjd-test(en ss fuzz / s)
(defun get( ...

谢谢，不过面积和周长应该不是充分条件

x_s_s_1 · 发表于 2023-3-23 13:11

mahuan1279 发表于 2023-3-23 11:44
平移、旋转、镜像。

谢谢，但是由于基点和基线的不确定性，效率应该有问题

mahuan1279 · 发表于 2023-3-23 13:33

x_s_s_1 发表于 2023-3-23 13:11
谢谢，但是由于基点和基线的不确定性，效率应该有问题

你是判断平面内两个闭合图形全等？还是找出所有全等的图形？

xtjd · 发表于 2023-3-23 14:11

x_s_s_1 发表于 2023-3-23 13:06
谢谢，不过面积和周长应该不是充分条件

x_s_s_1 · 发表于 2023-3-23 14:41

mahuan1279 发表于 2023-3-23 13:33
你是判断平面内两个闭合图形全等？还是找出所有全等的图形？

找出所有全等图形

x_s_s_1 · 发表于 2023-3-23 14:44

xtjd 发表于 2023-3-23 14:11

针对本测试图形是可以的，但是逻辑上不严密，有特例，仔细看92边形，有共线点，随便挪个点，你的代码就不对了。虽然边长和面积相等，但不是全等多边形。

x_s_s_1 · 发表于 2023-3-23 14:52

xtjd 发表于 2023-3-23 14:11

我在一楼添加了一个测试图形，您再试试

账号		自动登录	找回密码
密码			注册

[讨论] 求平面全等直线段封闭多边形最佳算法

评分

本帖子中包含更多资源