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

江湖远人

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

langjs

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

江湖远人

多谢二楼的推荐

jane2w

借用了哦谢谢

luojie110

学习了二楼的链接内容

mychenhan

谢谢langjs大神的分享

zml84

2. ;;;=================================================================*
   
3. ;;;功能：求多段线构成截面的形心。                                   *
   
4. ;;;                                                                 *
   
5. ;;;备忘：未考虑多段线是否封闭。                                     *
   
6. ;;;      系统变量的修改对其他程序的影响，尚未考虑。                 *
   
7. ;;;=================================================================*
   
8. ;;;日期：zml84 于 2014-07-16                                        *
   
9. ;;;=================================================================*
   
10. (defun c:JMTX2 (/ ss  i en ent filename f mj x y ixx iyy)
    
11.     (if        (and (princ "\n功能：批量选择多段线，标记形心")
    
12.              (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
13.              (setq i 0)
    
14.              (princ (sslength ss))
    
15.         )
    
16.         (repeat        (sslength ss)
    
17.             (setq en  (ssname ss i)
    
18.                   ent (entget en)
    
19.             )
    
20.             (progn
    
21.                 ;;设置系统变量
    
22.                 (setvar "CMDECHO" 0)
    
23.                 (setvar "FILEDIA" 0)
    
24.                 (setvar "LUPREC" 8)
    
25.                 (setvar "DELOBJ" 0)
    
26.                 ;;制作面域，测量其属性
    
27.                 (command "region" en "")
    
28.                 (setq filename "d:\\tmp.mpr") ;_文件名
    
29.                 (command "massprop" (entlast) "" "y" filename)
    
30.                 (entdel (entlast))
    
31.                 ;;读取文件，获取数值
    
32.                 (setq f (open filename "r"))
    
33.                 (read-line f)
    
34.                 (read-line f)
    
35.                 (read-line f)
    
36.                 (setq MJ (atof (substr (read-line f) 25))) ;_面积
    
37.                 (read-line f) ;_周长
    
38.                 (read-line f) ;_边界x
    
39.                 (read-line f) ;_边界Y
    
40.                 (setq X (atof (substr (read-line f) 25))) ;_质心x
    
41.                 (setq Y (atof (substr (read-line f) 25))) ;_质心y
    
42.                 (setq IXX (atof (substr (read-line f) 25))) ;_对x轴惯性矩
    
43.                 (setq IYY (atof (substr (read-line f) 25))) ;_对y轴惯性矩
    
44.                 (close f)
    
45.                 ;;(vl-file-delete filename)
    
46.                 ;;平行移轴，计算对通过质心的x轴、y轴惯性矩
    
47.                 (setq IXX2 (- IXX (* mj y y))
    
48.                       IYY2 (- IYY (* mj x x))
    
49.                 )
    
50.                 ;;结果显示
    
51.                 (princ
    
52.                     "\n**************************************************"
    
53.                 )
    
54.                 (princ (strcat "\n      面　　积:  A   = " (rtos mj 2 6))
    
55.                 )
    
56.                 (princ (strcat "\n      形心坐标: (X,Y)= ("
    
57.                                (rtos x 2 6)
    
58.                                ","
    
59.                                (rtos y 2 6)
    
60.                                ")"
    
61.                        )
    
62.                 )
    
63.                 (princ
    
64.                     (strcat "\n对质心轴惯性矩:  Ixx = " (rtos IXX2 2 6))
    
65.                 )
    
66.                 (princ
    
67.                     (strcat "\n                 Iyy = " (rtos Iyy2 2 6))
    
68.                 )
    
69.                 ;;标记圆心
    
70.                 (entmake
    
71.                     (list
    
72.                         '(0 . "CIRCLE")
    
73.                         '(62 . 10)
    
74.                         '(8 . "00.01 形心标记")
    
75.                         (cons 10 (trans (list x y) 1 0))
    
76.                         '(40 . 50)
    
77.                         '(210 0.0 0.0 1.0)
    
78.                     )
    
79.                 )
    
80.                 ;;恢复系统变量
    
81.                 (setvar "FILEDIA" 1)
    
82.                 (setvar "LUPREC" 0)
    
83.             )
    
84.             ;;
    
85.             (setq i (1+ i))
    
86.         )
    
87.     )
    
88.     (princ)
    
89. )

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