求平面全等直线段封闭多边形最佳算法
本帖最后由 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_listlst1 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))
)
)
(setqlst1(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) "毫秒"))
)
下面是测试图形
平移、旋转、镜像。 (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)))
(setqs(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) "毫秒"))
) 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( ...
谢谢，不过面积和周长应该不是充分条件 mahuan1279 发表于 2023-3-23 11:44
平移、旋转、镜像。
谢谢，但是由于基点和基线的不确定性，效率应该有问题 x_s_s_1 发表于 2023-3-23 13:11
谢谢，但是由于基点和基线的不确定性，效率应该有问题
你是判断平面内两个闭合图形全等？还是找出所有全等的图形？
x_s_s_1 发表于 2023-3-23 13:06
谢谢，不过面积和周长应该不是充分条件
mahuan1279 发表于 2023-3-23 13:33
你是判断平面内两个闭合图形全等？还是找出所有全等的图形？
找出所有全等图形 xtjd 发表于 2023-3-23 14:11
针对本测试图形是可以的，但是逻辑上不严密，有特例，仔细看92边形，有共线点，随便挪个点，你的代码就不对了。虽然边长和面积相等，但不是全等多边形。 xtjd 发表于 2023-3-23 14:11
我在一楼添加了一个测试图形，您再试试