如何自动生成不规则多边形的质心

hrer

我是用region转成面域，然后用massprop显示质心坐标，复制出来，再画的。
能帮编写个command语句，自动画出被选择(已知）的多边形（1或多个最好）质心，多谢~！

langjs

以前收集的一个源码
;;; 截面特性＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(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)
)

GILES.LEI

;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 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;;;
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ...

大佬，能不能把生成的点改为十字中心线

skynoon

拜读           

hrer

哇，太复杂了对于我这个初学者，不过还是多谢，希望能从中自己编一个

hrer

langjs 发表于 2012-2-13 21:01
以前收集的一个源码
;;; 截面特性＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:tx (/ angel2 angle1 ang ...

麻烦帮修改一下，只要能画出被选择的多边形的质心就成，你的代码太高深了，呵呵

langjs

上面代码修改后剩一点点了。
;;; 画闭合图形质心点
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(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)
)

hrer

langjs 发表于 2012-2-13 23:15
上面代码修改后剩一点点了。
;;; 画闭合图形质心点
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

太完美了，多谢！不知道从哪方面开始学lsp语句，碰到问题就只好请教了。

langjs

来个多个闭合区域一起框选的。

;;; 框选多个闭合图形画质心点 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)
)

yshf

参考：
qjchen 写的 http://bbs.mjtd.com/forum.php?mo ... mp;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/questio ... ntroid-of-a-polygon

gile和Evgeniy也曾经写过带弧线的多线的Lisp代码，不过方法要更加复杂了

假如还需要二次矩的计算的话，可以参考这里
http://paulbourke.net/geometry/polyarea/上面这个网站还有大量的几何图形知识，在http://paulbourke.net/geometry/

springwillow

太高深了，看不懂啊！只能先用了。谢谢楼主了！