yanguangfei 发表于 2012-12-16 10:46:44

[求多边形内相对中心点] 源码

本帖最后由 yanguangfei 于 2012-12-16 10:50 编辑


很费神的收点辛苦费啦
求得的点不会出多边形奥
感谢辰 提供算法
感谢E派指正
感谢 所有关注求闭合多段线的心【不是一般的心】（望高手出手）感激不尽（已解决） 的人


http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 yanguangfei的微博

mitenickevin 发表于 2013-7-3 10:42:35

没币下不了。

轮回 发表于 2022-2-21 15:35:35

大神告诉我，坐标值大了的情况下IntersectWith交点在顶点0.01范围内就会出错，所以会出现14楼那种错误，所以我在代码里加了一点修正。这个函数在测绘里还是很有用的！;;;求多边形内相对中心点
;;; 2012-11-15
;;; 感谢 辰   提供方法
;;; 感谢 学院派 指正
;;;by yanguangfei
(defun Get_center_relative (ename / 2R DelLine DistList i lst lst1 Mk Mkline N Newlst Number obj points Pt pt1 Pts R Tssbak Tssred TssSub)
(setq Obj   (Vlax-Ename->Vla-Object ename)
    Tssbak(Vlax-Get Obj 'Thickness )
    TssSub(Vlax-Put Obj 'Thickness 0 )
   
)
(setq Pts   (GetBoundingBox ename)
    2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))
    Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R pi 1000))))
    Mkline(entlast)
    points(vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
    Tssred(Vlax-Put Obj 'Thickness (eval Tssbak) )
    DelLine (entdel Mkline)
    i       0
    lst   nil
    lst1   nil
)
(repeat (/ (length points) 3)
    (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
    (setq i (+ i 3))
)
(foreach p1 lst;去掉vla-IntersectWith的bug
    (setq pt1 (vlax-curve-getClosestPointTo ename p1))
    (if (equal pt1 p1 1e-8)
      (setq lst1 (append (list p1) lst1))
    )
)
(setq lst (px lst1))
(if (>= (length lst) 4)
    (progn
      (setq N      0
      Newlst nil)
      (repeat (/ (length lst) 2)
      (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
      (setq N (+ 2 N))
      )
      (setq DistList nil
      R      0)
      (repeat (length Newlst)
      (setq Number (nth R Newlst)
          DistList (append DistList(list(distance (car Number) (cadr Number)))))
      (setq R (1+ R))
      )
      (setqPt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
      (MJ:MIDPOINT (car pt) (cadr pt));返回值
    )
    (MJ:MIDPOINT (car lst) (cadr lst));返回值
)
)

本何处来 发表于 2022-4-13 16:44:32

轮回 发表于 2022-2-21 15:35
大神告诉我，坐标值大了的情况下IntersectWith交点在顶点0.01范围内就会出错，所以会出现14楼那种错误，所 ...

用了一下。提示：错误: 参数太少。不懂问题在哪

xiabin68 发表于 2012-12-16 19:10:48

这么快哦，，先支持一个，，下来试一试，，，，

004 发表于 2012-12-21 13:26:23

好程序。顶一下。

xxzwtr 发表于 2013-2-28 23:41:05

发发

lq8000 发表于 2013-5-2 11:41:26

找了好久终于解决了。

yshf 发表于 2013-5-4 20:01:03

本帖最后由 yshf 于 2013-5-4 22:10 编辑

没有那条水平线与多边形交点数为奇数时的处理

328302216 发表于 2013-7-3 11:11:58

暂时用不上，不过有源码，顶起

开1心 发表于 2013-7-11 19:55:21

为了测试，我必须下啊~~

zjy2999 发表于 2013-12-31 13:36:39

支持，下载学习了
页: [1] 2
查看完整版本: [求多边形内相对中心点] 源码