求闭合多段线的心【不是一般的心】（望高手出手）感激不尽（已解决）
本帖最后由 yanguangfei 于 2012-12-15 18:11 编辑不能用 GetBoundingBox
求得的点一定要在多边形内尽量靠中间
接近中心就行多边形复杂时求出的结果不能出封闭多线
能提供算法或加密独立函数也行
源码最好
再次先谢
;;;求型心坐标
;;;(defun GetCoord (ename)
;;; (COmmand "mapcreatecentroids" "s" ename "" "")
;;; (setq pts (Vlax-Get (Vlax-Ename->Vla-Object (setq delpt (entlast))) 'Coordinates ))
;;; (entdel delpt)
;;;pts
;;;)
这个命令是AUTO Map 3D 自带的一个命令 反复调用会错误
改后的程序
虽然不是很理想但凑合了
感谢所有关注的人
;;;测试函数
(defun c:tt ( / ss s)
(setq ss (ssget '((0 . "*poLyline")))
S 0)
(if ss
(repeat (sslength ss)
(command "point" (Get_center (ssname ss s)))
(setq s (1+ s))
)
)
)
;;;测试函数
(defun c:test ()
(while T
(command "point" (Get_center(car(entsel))))
)
)
;;;求多边形内相对中心点
;;;by yanguangfei
(defun Get_center (ename /Pts 2R MkMkline points DelLine
i lst N Newlst DistList R Number Pt)
(setq Pts (GetBoundingBox ename)
2R (MJ:MIDPOINT (CAR Pts) (CADR Pts))
Mk (entmake (list (cons 0 "LINE")(cons 10 (polar 2R 0.0 300))(cons 11 (polar 2R 3.14159 300))))
Mkline(entlast)
points(vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
DelLine (entdel Mkline)
i 0
lst 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))
)
(setq lst (px lst))
(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));返回值
)
)
(defun MJ:MIDPOINT (P1 P2)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
(defun GetBoundingBox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
(defun px (X)
(vl-sortX
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) ) )
)
;; tt(闭合曲线内部点)
(defun c:tt ()
(xyp-Start)
(setq i -1)
(if (setq ss (ssget '((0 . "*POLYLINE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-point (xyp-PtInCurve s1 nil))
)
)
(xyp-End)
)
质心的话，不一定是在多段线内的啊，如果两头面积很大，中间通过一个小廊连接的话，质心会在多段线外面的， chpmould 发表于 2012-12-13 19:46
不知这个要求用在什么行业
测绘,整体中心,线内 明天发给你一段代码，是G版给我的，现在手机上的不方便 利用ActiveX，由多以线生成面域，再利用(vla-get-centroid regobj) 即可得到质心啊
本帖最后由 highflybir 于 2012-12-11 22:41 编辑
多边形的形心（质心）不一定在多边形内部。 附件内的fas文件只包含函数get_centroid (仅对封闭多以线有效),你可以封装在你的文件内
测试代码如下：(vl-load-com)
(defun c:test (/ ent res)
(if (not (setq ent (car (entsel))))
(exit)
(progn
(setq res (get_centroid ent))
(princ res)
)
)
(princ)
)正如‘飞得更高’所说，形心不一定在内部 xiabin68 发表于 2012-12-11 21:49 static/image/common/back.gif
明天发给你一段代码，是G版给我的，现在手机上的不方便
先谢过 嘿嘿 形心已出，详细附件
BTW: Autocad计算的质心很准确的，因为工作的原因经常用到ansys , 比较过
两者计算的一模一样 那我就不知道了，只有等高手解决
本帖最后由 yanguangfei 于 2012-12-11 23:56 编辑
测试结果 还是跑外面了
sunny20102
你的那个心没有什么一定的标准，很模糊，仅仅满足在内部和尽量接近就行了的话，这样的点有很多个。
而且你提供的样例图中的那些中心没有一个是质心的，即使是不复杂的多边形也不是质心。
所以建议楼主能更明确要求。