求凹多边形(多线段)的凸包

aimisiyou · 发表于 2016-10-15 08:50:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 aimisiyou 于 2016-10-15 09:10 编辑

;;;向量叉乘
(defun sfun (pt1 pt2 pt3)
   (setq va (-
               (* (- (car pt2) (car pt1)) (- (cadr pt3) (cadr pt2)) )
               (* (- (car pt3) (car pt2)) (- (cadr pt2) (cadr pt1)) )
               )
      )
)
(defun fxfun (pts)
;;;获取横坐标最小的点在顶点集中的位置
(setq n0 (car (vl-sort-i pts
                        (function (lambda (e1 e2)
                                          (< (car e1) (car e2))
                                    )
                        )
               )
         )
   )
(setq xmin (car (nth n0 pts)))
(setq xmins (vl-remove nil (mapcar '(lambda (x) (if (= xmin (car x)) x ))  pts)))
;;;判断闭合多线段方向
(if (= (length xmins) 1)
      (setq flag (cond
            ((= n0 0) (sfun (last pts) (car pts) (cadr pts )))
            ((= n0 (- (length pts) 1)) (sfun (car (cdr (reverse pts))) (last pts)  (car pts )) )
            (t (sfun (nth (- n0 1) pts) (nth n0 pts) (nth (+ n0 1) pts)))
         )
      )
      (if (< (cadr (car xmins)) (cadr (cadr xmins)))  (setq flag -1) (setq flag 1))
   )
(if (< flag 0) (setq vs -1)(setq vs 1))
vs
)
(defun hfun (pts)
(if (>= (sfun (last pts) (car pts) (cadr pts )) 0)  (setq v1 1) (setq v1 -1) )
(if (>= (sfun (car (cdr (reverse pts))) (last pts)  (car pts )) 0)  (setq vn 1)(setq vn -1))
(setq vllst (mapcar '(lambda (x y z)
                           (if (< (sfun x y z) 0) -1 1)
                     )
                     pts
                  (cdr pts)
                  (cdr (cdr pts))
            )
)
(setq vlst (append (list v1) vllst (list vn)))
vlst
)
(setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel))))))
(setq fn (fxfun pts))
(while (/= (length pts) (* fn (apply '+ (hfun pts))))
   (setq pts (vl-remove nil (mapcar '(lambda (x y) (if (= (* fn x) 1) y))  (hfun pts) pts)))
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))

Lisphk · 发表于 2016-10-15 10:51:00

这个给力，拷回去测试下

aimisiyou · 发表于 2016-10-15 17:01:36

本帖最后由 aimisiyou 于 2016-10-15 17:08 编辑

重装浏览器，终于可以上传图片了。
凹多边形如果只通过顶点连线进行凸分，往往没有借助辅助点的凸分效果好（一是分割凸多边形数目少，而是分割的凸多边形形态较好）。

HLCAD · 发表于 2016-10-16 09:16:50

好程序，谢谢楼主分享！

thtgp · 发表于 2020-11-20 00:19:21

好东东，谢谢了

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

[研讨] 求凹多边形(多线段)的凸包

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。