江湖远人 发表于 2012-5-17 20:40:31

求助，求高手编一个“求不规则图形形心坐标”的程序

最近遇到一个问题，需要求不规则图形形心的坐标，求高手帮忙！！！

langjs 发表于 2012-5-17 22:11:41

http://bbs.mjtd.com/thread-92028-1-1.html

江湖远人 发表于 2012-5-17 23:07:59

多谢二楼的推荐

jane2w 发表于 2013-7-7 10:24:16

借用了哦谢谢

luojie110 发表于 2017-12-27 12:10:12

学习了二楼的链接内容

mychenhan 发表于 2023-3-9 22:49:40

谢谢langjs大神的分享

zml84 发表于 2023-3-11 16:27:45

;;;=================================================================*
;;;功能：求多段线构成截面的形心。                                 *
;;;                                                               *
;;;备忘：未考虑多段线是否封闭。                                     *
;;;      系统变量的修改对其他程序的影响，尚未考虑。               *
;;;=================================================================*
;;;日期：zml84 于 2014-07-16                                        *
;;;=================================================================*
(defun c:JMTX2 (/ ssi en ent filename f mj x y ixx iyy)
    (if        (and (princ "\n功能：批量选择多段线，标记形心")
             (setq ss (ssget '((0 . "LWPOLYLINE"))))
             (setq i 0)
             (princ (sslength ss))
        )
        (repeat        (sslength ss)
          (setq en(ssname ss i)
                  ent (entget en)
          )
          (progn
                ;;设置系统变量
                (setvar "CMDECHO" 0)
                (setvar "FILEDIA" 0)
                (setvar "LUPREC" 8)
                (setvar "DELOBJ" 0)
                ;;制作面域，测量其属性
                (command "region" en "")
                (setq filename "d:\\tmp.mpr") ;_文件名
                (command "massprop" (entlast) "" "y" filename)
                (entdel (entlast))
                ;;读取文件，获取数值
                (setq f (open filename "r"))
                (read-line f)
                (read-line f)
                (read-line f)
                (setq MJ (atof (substr (read-line f) 25))) ;_面积
                (read-line f) ;_周长
                (read-line f) ;_边界x
                (read-line f) ;_边界Y
                (setq X (atof (substr (read-line f) 25))) ;_质心x
                (setq Y (atof (substr (read-line f) 25))) ;_质心y
                (setq IXX (atof (substr (read-line f) 25))) ;_对x轴惯性矩
                (setq IYY (atof (substr (read-line f) 25))) ;_对y轴惯性矩
                (close f)
                ;;(vl-file-delete filename)
                ;;平行移轴，计算对通过质心的x轴、y轴惯性矩
                (setq IXX2 (- IXX (* mj y y))
                      IYY2 (- IYY (* mj x x))
                )
                ;;结果显示
                (princ
                  "\n**************************************************"
                )
                (princ (strcat "\n      面　　积:A   = " (rtos mj 2 6))
                )
                (princ (strcat "\n      形心坐标: (X,Y)= ("
                             (rtos x 2 6)
                             ","
                             (rtos y 2 6)
                             ")"
                     )
                )
                (princ
                  (strcat "\n对质心轴惯性矩:Ixx = " (rtos IXX2 2 6))
                )
                (princ
                  (strcat "\n               Iyy = " (rtos Iyy2 2 6))
                )
                ;;标记圆心
                (entmake
                  (list
                        '(0 . "CIRCLE")
                        '(62 . 10)
                        '(8 . "00.01 形心标记")
                        (cons 10 (trans (list x y) 1 0))
                        '(40 . 50)
                        '(210 0.0 0.0 1.0)
                  )
                )
                ;;恢复系统变量
                (setvar "FILEDIA" 1)
                (setvar "LUPREC" 0)
          )
          ;;
          (setq i (1+ i))
        )
    )
    (princ)
)
页: [1]
查看完整版本: 求助，求高手编一个“求不规则图形形心坐标”的程序