如何自动生成不规则多边形的质心
本帖最后由 hrer 于 2012-2-13 21:08 编辑我是用region转成面域，然后用massprop显示质心坐标，复制出来，再画的。
能帮编写个command语句，自动画出被选择(已知）的多边形（1或多个最好）质心，多谢~！
以前收集的一个源码
;;; 截面特性＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:tx (/ angel2 angle1 angle2 area arrowlen centroid circlerad jmobj momentofinertia1 perimeter principaldirections1
principalmoments1 productofinertia1 regionobj ss txthight txtpt txtstring uuuuu x
)
(defun v2l (x)
(vlax-safearray->list (vlax-variant-value x))
)
(defun jmcsfun (jmobj / area perimeter centroid momentofinertia1 principalmoments1 principaldirections1 productofinertia1 txthight
circlerad arrowlen angle1 angel2 txtpt txtstring
)
(setq area (vla-get-area jmobj)
perimeter (vla-get-perimeter jmobj)
centroid (v2l (vla-get-centroid jmobj)) ; momentofinertia (v2l(vla-get-momentofinertia
; jmobj))
; principalmoments(v2l(vla-get-principalmoments jmobj))
; principaldirections(v2l(vla-get-principaldirections jmobj))
; productofinertia (vla-get-productofinertia jmobj)
)
(vla-move jmobj (vlax-3d-point centroid) (vlax-3d-point (list 0 0 0)))
(setq momentofinertia1 (v2l (vla-get-momentofinertia jmobj))
principalmoments1 (v2l (vla-get-principalmoments jmobj))
principaldirections1 (v2l (vla-get-principaldirections jmobj))
productofinertia1 (vla-get-productofinertia jmobj)
)
(vla-move jmobj (vlax-3d-point (list 0 0 0)) (vlax-3d-point centroid))
(setq txthight (/ (getvar "viewsize") 90.0))
(setq circlerad (* txthight 1.5))
(setq arrowlen (* txthight 5))
(setq angle1 (angle (list 0 0 0) (list (car principaldirections1) (caddr principaldirections1))))
(setq angle2 (angle (list 0 0 0) (list (cadr principaldirections1) (cadddr principaldirections1))))
(setq txtpt (polar centroid angle1 arrowlen))
(entmake (list (cons 0 "line") (cons 10 centroid) (cons 11 txtpt) (cons 62 1)))
(entmake (list (cons 0 "text") (cons 1 "1") (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt) (cons 62 1)))
(setq txtpt (polar centroid angle2 arrowlen))
(entmake (list (cons 0 "line") (cons 10 centroid) (cons 11 txtpt) (cons 62 1)))
(entmake (list (cons 0 "text") (cons 1 "2") (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt) (cons 62 1)))
(setq txtstring (strcat "面积= " (rtos area 2 2) " mm2")
txtpt centroid
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "周长= " (rtos perimeter 2 2) " mm")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "Ix= " (rtos (car momentofinertia1) 2 0) " mm4")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "Iy= " (rtos (cadr momentofinertia1) 2 0) " mm4")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "Ixy= " (rtos productofinertia1 2 0) " mm4")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "I1= " (rtos (car principalmoments1) 2 0) " mm4")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
(setq txtstring (strcat "I2= " (rtos (cadr principalmoments1) 2 0) " mm4")
txtpt (list (car txtpt) (- (cadr txtpt) (* txthight 2)))
)
(entmake (list (cons 0 "text") (cons 1 txtstring) (cons 40 txthight) (cons 10 txtpt) (cons 11 txtpt)))
)
(setvar "cmdecho" 0) ; 关闭命令响应
(command ".UNDO" "BE")
(princ "\n选择闭合区域。")
(setq ss (ssget))
(if ss
(progn
(command ".region" ss "")
(setq uuuuu (entlast))
(if (= (cdr (assoc 0 (entget uuuuu))) "REGION")
(progn
(vl-load-com)
(setq regionobj (vlax-ename->vla-object uuuuu))
(jmcsfun regionobj)
(princ "\n\n图中所表示的惯性矩意义如下:\n\n 两条直线代表主矩方向1和2\n I1为主矩方向1的质心主惯性矩\n I2为主矩方向2的质心主惯性矩\n Ix,Iy,Ixy均为质心惯性矩")
(command ".explode" uuuuu)
(princ)
)
(princ "\n图元不闭合,无法计算。")
)
)
(princ "\n没有选择对象。")
)
(command ".UNDO" "E")
(princ)
)
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 by:langjs;;;
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:XX (/ en ent i obj pt ptls snap ss ss1)
(setvar "cmdecho" 0) ; 关闭命令行显示
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq snap (getvar "osmode"))
(setvar "osmode" 0)
(setq en (entlast))
(command ".region" ss ""); 对选择集做面域
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(ssadd en ss)
)
(if (zerop (sslength ss))
(setq ss nil)
)
)
(setq ss (ssget "_x"))
)
(setq ss1 (ssadd))
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(if (= (cdr (assoc 0 (entget ent))) "REGION"); 如果成功生成面域
(progn
(vl-load-com)
(setq obj (vlax-ename->vla-object ent))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))); 取得质心坐标
(command ".point" pt); 画质心点
(setq ptls (entlast))
(command ".explode" ent); 分解面域
(setq NS (ssget "p"))
(command "Peditaccept" "0" ""); 打开多段线合并询问提示
(command "pedit" "m" NS "" "y" "j" "" ""); 合并
(setq ss1 (ssadd ptls ss1))
)
)
)
(sssetfirst nil ss1); 夹点亮显质心点
(setvar "osmode" snap)
)
(princ "\n没有选择对象.")
)
(setvar "cmdecho" 1) ; 开启命令行显示
(princ)
)
GILES.LEI 发表于 2016-10-13 16:36
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 by:langjs;;;
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ...
大佬，能不能把生成的点改为十字中心线:loveliness: 拜读 哇，太复杂了对于我这个初学者，不过还是多谢，希望能从中自己编一个 langjs 发表于 2012-2-13 21:01 static/image/common/back.gif
以前收集的一个源码
;;; 截面特性＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:tx (/ angel2 angle1 ang ...
麻烦帮修改一下，只要能画出被选择的多边形的质心就成，你的代码太高深了，呵呵 上面代码修改后剩一点点了。
;;; 画闭合图形质心点
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:drp (/ ent obj pt ptls ss)
(setvar "cmdecho" 0) ; 关闭命令响应
(princ "\n选择闭合区域:")
(if (setq ss (ssget))
(progn
(command ".region" ss "") ; 对选择集做面域
(setq ent (entlast))
(if (= (cdr (assoc 0 (entget ent))) "REGION") ; 如果成功生成面域
(progn
(vl-load-com)
(setq obj (vlax-ename->vla-object ent))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))) ; 取得质心坐标
(command ".point" pt) ; 画质心点
(setq ptls (entlast))
(command ".explode" ent)
(sssetfirst nil (ssadd ptls (ssadd))) ; 夹点亮显质心点
)
(princ "\n错误:图形不闭合,无法计算.")
)
)
(princ "\n错误:没有选择对象.")
)
(princ)
)
langjs 发表于 2012-2-13 23:15 static/image/common/back.gif
上面代码修改后剩一点点了。
;;; 画闭合图形质心点
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
太完美了，多谢！不知道从哪方面开始学lsp语句，碰到问题就只好请教了。 来个多个闭合区域一起框选的。
;;; 框选多个闭合图形画质心点 by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:aa (/ en ent i obj pt ptls snap ss ss1)
(setvar "cmdecho" 1)
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq snap (getvar "osmode"))
(setvar "osmode" 0)
(setq en (entlast))
(command ".region" ss "")
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(ssadd en ss)
)
(if (zerop (sslength ss))
(setq ss nil)
)
)
(setq ss (ssget "_x"))
)
(setq ss1 (ssadd))
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(if (= (cdr (assoc 0 (entget ent))) "REGION")
(progn
(vl-load-com)
(setq obj (vlax-ename->vla-object ent))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
(command ".point" pt)
(setq ptls (entlast))
(command ".explode" ent)
(setq ss1 (ssadd ptls ss1))
)
)
)
(sssetfirst nil ss1)
(setvar "osmode" snap)
)
(princ "\n没有选择对象.")
)
(princ)
)
参考：
qjchen 写的 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91845&page=1#pid504508
http://en.wikipedia.org/wiki/Centroid#Centroid_of_polygon
其中的这个就是公式
Centroid of polygon
The centroid of a non-self-intersecting closed polygon defined by n vertices (x0,y0), (x1,y1), ..., (xn−1,yn−1) is the point (Cx, Cy), where [对于一个封闭的非自交的多边形，形心公式如下]
and where A is the polygon's signed area,
In these formulas, the vertices are assumed to be numbered in order of their occurrence along the polygon's perimeter, and the vertex ( xn , yn ) is assumed to be the same as ( x0 , y0 ). Note that if the points are numbered in clockwise order the area A, computed as above, will have a negative sign; but the centroid coordinates will be correct even in this case [注意，有可能计算出来的面积会是负数，但是形心的位置是不会错的]
假如需要代码的话，可以参考这里 http://stackoverflow.com/questions/2792443/finding-the-centroid-of-a-polygon
gile和Evgeniy也曾经写过带弧线的多线的Lisp代码，不过方法要更加复杂了
假如还需要二次矩的计算的话，可以参考这里
http://paulbourke.net/geometry/polyarea/上面这个网站还有大量的几何图形知识，在http://paulbourke.net/geometry/
太高深了，看不懂啊！只能先用了。谢谢楼主了！