[LISP程序]：谁有寻找形心的程序啊

fbravet

适用于2004的
lisp或者arx的都无所谓的
谁能帮忙写一个好么
结构上很有需要的噢

eachy

xdrx_curve_info

功    能：获得AcDbCurve曲线实体(polyline,lwpolyline,arc,circle,ellipse,spline)
          和AcDbRegion(REGION面域)实体的面积，周长，质心，惯性矩，回转半径，边界盒等信息。
          (得到的信息同命令massprop得到的Region的信息。但对于曲线不用得到region就能求得。

调用格式：(xdrx_getcurveinfo <Curve曲线或Region面域实体名>)

返 回 值：各个信息组成的关联表。

说    明：对于不封闭的曲线，面积是把曲线开始点和终止点用直线闭合后的面积
          但周长不计算最后的封闭直线段的长度。

示    例：下面信息使用该函数得到的Polyline的信息。

       (("Perimeter" 26485.5) ("Area" 8.96831e+007) ("Centroid" (18350.9 11745.1))
        ("MomInertia" 1.30432e+016 3.09809e+016) ("ProdInertia" 1.95954e+016)
        ("PrinMoments" 4.54504e+014 9.96837e+014) ("PrinAxes" (0.774289 0.632833) (-0.632833 0.774289))
        ("RadGyration" 12059.7 18586.2) ("Box" (11075.9 6655.67) (23993.4 17421.3))
       )

       下面是MASSPROP命令得到的转换为Region后的POLYLINE的信息。和上面得到的信息在周长上不同。
       因为做面域的时候用了封闭的线。
       Command: massprop
       Select objects: 1 found
       Select objects:
       ---------------- REGIONS ----------------
        Area: 89683065
        Perimeter: 37673
        Bounding box: X: 11076 -- 23993
                      Y: 6656 -- 17421
        Centroid: X: 18351
                  Y: 11745
        Moments of inertia: X: 1E+16
                            Y: 3E+16
        Product of inertia: XY: 2E+16
        Radii of gyration: X: 12060
                           Y: 18586
        Principal moments and X-Y directions about centroid:
        I: 454503674971976 along [1 1]
        J: 996836689445791 along [-1 1]
       各参数意义：

        下表列出了 AutoCAD 为实体显示的质量特性。

            实体的质量特性

            质量特性 描述
            质量 用于度量物体的惯性。AutoCAD 使用的密度为 1，所以质量和体积的值相同。
            体积 实体包容的三维空间总量。

            面积 (Area) 实体的表面面积或面域的封闭面积。

            周长 (Perimeter) 面域的内环和外环的总长度。AutoCAD 不计算实体的周长。
        
            质心 (Centroid) 代表面域中心点的二维或三维坐标。对于与当前用户坐标系的 XY 平面共面的面域，
            质心是一个二维点。对于与当前用户坐标系的 XY 平面不共面的面域，质心是一个三维点。

            惯性矩(MomInertia) 质量惯性矩，用来计算绕给定的轴旋转对象（例如车轮绕车轴旋转）时所需的力。
            惯性矩的计算公式是：质量惯性矩 = 对象质量*轴半径*轴半径
            质量惯性矩的单位是质量（克或斯勒格）乘以距离的平方。

            惯性积(ProdInertia) 用来确定导致对象运动的力，通常通过两个正交平面计算。计算 YZ 平面和 XZ 平面
            惯性积的公式是：惯性积(YZ,XZ) = 质量*质心到平面 YZ 的距离*质心到平面 XZ 的距离
            这个 XY 值的单位是质量乘以距离的平方。

            旋转半径(RadGyration) 表示实体惯性矩的另一种方法。
            计算旋转半径的公式是：旋转半径=（惯性积 / 物体质量）1/2 旋转半径的单位就是距离单位。

            主力矩和质心的 X、Y、Z 轴 (PrinMoments) (PrinAxes)
            由惯性积得出，它们具有相同单位。在对象的质心处有一个确定的轴，
            ? 对应这个轴的惯性矩最大。另有一个轴与第一个轴相垂直，并且也通过质心，对应它的惯性矩最?
            由此导出第三个轴，其惯性矩介于最大值与最小值之间。

            边界框(Box) 显示用于定义边界框的两个坐标。对于与当前用户坐标系的 XY 平面共面的面域，
            边界框由包含该面域的矩形的对角点定义。对于与当前用户坐标系的 XY 平面不共面的面域，
            边界框由包含该面域的三维的对角点定义。

e2002

以前我贴过的,你找找看?
用于标注封闭LwPolyline的形心

csun

一个只能求闭合多线段的形心，求好后的形心放置在“point”图层，如下：
(defun c:zxx (/ ss se rg f xxx xxy xxx1 xxy1 xxx2 xxy2 cep oldom oldcm oldfd oldlp oldla i n enpt)
  (prompt "形心求解器修改版 v0.1 2004年3月22日")
  (prompt "\n 请选取欲求形心的闭合无自交的多义线：")
  (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))
  (if ss
    (progn
       (setq oldla (getvar "CLAYER"))
       (setq oldcm (getvar "CMDECHO"))
       (setq oldfd (getvar "FILEDIA"))
       (setq oldlp (getvar "LUPREC"))
       (setq oldom (getvar "OSMODE"))
       (setvar "CMDECHO" 0)
       (setvar "FILEDIA" 0)
       (setvar "LUPREC" 8)
       (setvar "OSMODE" 0)
       (setq i 0)
       (setq n (sslength ss))
       (repeat n
         (setq se (ssname ss i))
         (command "_copy" se "" "0,0" "0,0")
         (command "region" se "")
         (setq rg (entget (entlast)))
         (command "massprop" "l" "" "y" "c:/ZZX.mpr")
         (command "_erase" "l" "")
         (setq f (open "c:/ZZX.mpr" "r"))
         (read-line f)
         (read-line f)
         (read-line f)
         (read-line f)
         (read-line f)
         (read-line f)
         (read-line f)
         (setq xxx (read-line f))
         (setq xxy (read-line f))
         (close f)
         (setq xxx1 (substr xxx 25 20))
         (setq xxy1 (substr xxy 25 20))
         (setq xxx2 (atof xxx1))
         (setq xxy2 (atof xxy1))
         (setq cep (list xxx2 xxy2 0))
         (setq enpt (entmake (list (cons 0 "point")(cons 8 "point") (cons 10 cep))))
         (setq i (+ i 1))
       );;;end repeat
       (setvar "FILEDIA" oldfd)
       (setvar "LUPREC" oldlp)
       (setvar "CMDECHO" oldcm)
       (setvar "OSMODE" oldom)
       (setvar "CLAYER" oldla)
       (if enpt
         (progn
           (command "-layer" "on" "point" "")
           (if (/= (getvar "pdmode") 3) (setvar "pdmode" 3))
           (if (/= (getvar "pdsize") 200) (setvar "pdsize" 200))
         );;;end progn
       );;;end progn
       (princ)
       (prompt "\n\n 多义线的形心已用点显示在point图层，如果有必要请定义过点的形式以显示得更好")
      );;;end progn
    (prompt "\n 没有选到任何多义线")
  );;;end if
  (princ)
);;;end defun

----------------------------------------------------------------
一个是可以求某一图层上封闭实体的形心，程序根据你输入的图层自动选择该层上所有实体，再根据你点取的点求取点所在周边封闭实体的形心并显示在“point”图层上，如下：
(defun c:ez (/ f xxx xxy xxx1 xxy1 xxx2 xxy2 cep oldom oldcm oldbm oldfd oldlp oldla pt en ptlist ss la enpt)
  (prompt "形心求解器修改版 v0.2 2004年6月26日")
  (setq oldla (getvar "CLAYER"))
  (setq oldcm (getvar "CMDECHO"))
  (setq oldfd (getvar "FILEDIA"))
  (setq oldlp (getvar "LUPREC"))
  (setq oldom (getvar "OSMODE"))
  (setq oldbm (getvar "BLIPMODE"))
  (setvar "CMDECHO" 0)
  (setvar "FILEDIA" 0)
  (setvar "LUPREC" 8)
  (setvar "OSMODE" 0)
  (setvar "BLIPMODE" 1)
  (if (not laname) (setq laname "c-h"))
  (setq la (getstring (strcat "\n请输欲求形心的实体所在图层名<" laname "或当前层>:")))
  (if (= la "") (setq la laname) (setq laname la))
  (if (tblsearch "LAYER" la)
     (setq ss (ssget "X" (list (cons 8 la))))
     (setq ss (ssget "X"))
  )
  (while
     (setq pt (getpoint "\n请点取欲求形心的封闭实体内部点:"))
     (setq ptlist (append ptlist (list pt)))
  )
  (if ss
    (progn
      (if ptlist
        (progn
          (foreach pt ptlist
           (command "-boundary" "a" "o" "r" "b" "n" ss "" "" pt "")
           (setq en (entget (entlast)))
           (if (equal (assoc 0 en) '(0 . "REGION"))
             (progn
                (command "massprop" "l" "" "y" "c:/ZZX.mpr")
                (command "_erase" "l" "")
                (setq f (open "c:/ZZX.mpr" "r"))
                (read-line f)
                (read-line f)
                (read-line f)
                      (read-line f)
                      (read-line f)
                       (read-line f)
                      (read-line f)
                      (setq xxx (read-line f))
                      (setq xxy (read-line f))
                      (close f)
                      (setq xxx1 (substr xxx 25 20))
                      (setq xxy1 (substr xxy 25 20))
                    (setq xxx2 (atof xxx1))
                (setq xxy2 (atof xxy1))
                (setq cep (list xxx2 xxy2 0))
                (setq enpt (entmake (list (cons 0 "point")(cons 8 "point") (cons 10 cep))))
             );;;end progn
             (prompt "\n没有选到符合求形心条件的东东，退出！")
           );;;end if
          );;;end foreach
          (if enpt
            (progn
              (command "-layer" "on" "point" "")
              (if (/= (getvar "pdmode") 3) (setvar "pdmode" 3))
              (command "_redraw")
              (princ)
              (prompt "\n\n 多义线的形心已用点显示在point图层，如果有必要请定义过点的形式以显示得更好")
            );;;end progn
          );;;end if
        );;;end progn
        (prompt "\n 没有选到任何点，退出！")
      );;;end if ptlist
    );;;end progn
    (prompt "\n没有选到符合求形心条件的东东，退出！")
  );;;end if ss
  (setvar "FILEDIA" oldfd)
  (setvar "LUPREC" oldlp)
  (setvar "CMDECHO" oldcm)
  (setvar "OSMODE" oldom)
  (setvar "CLAYER" oldla)
  (setvar "BLIPMODE" oldbm)
  (princ)
);;;end defun

WRHCHINA

很好的东西！无可挑剔。

eachy

http://open.jstvu.edu.cn:7999/gclx2/ydts/menu.htm
[iframe h=600]http://open.jstvu.edu.cn:7999/gclx2/ydts/menu.htm[/iframe]
http://water.hre.ntou.edu.tw/~egtcad/doct/h16/

[iframe h=600]http://water.hre.ntou.edu.tw/~egtcad/doct/h16/[/iframe]
http://elearning.stut.edu.tw/mechanical/Statics/newpage32.htm
[iframe h=600]http://elearning.stut.edu.tw/mechanical/Statics/newpage32.htm[/iframe]

xingbaoquan99

tssd2.7里面有自动标记柱子形心,
在autocad内首先用region生成一个域，然后用查找特性就可以找到形心坐标.

它山之石

1、TSSD2.7里面没有了柱子形心功能，原来的版本曾经有过，也只能对矩形求形心，后来就取消此功能了。
2、在CAD里用“massprop”命令可以看到形心坐标。
3、4楼楼主的程序很好。利用晓东API可以再简化代码。

我刚才用晓东API写了这个程序，欢迎大家试用，因为不能连续发贴，只好编辑一下。
1、我将形心点画在了"defpoints"层，打印时不会打出来。
2、我在选取实体时对柱子的图层进行了设定，大家可根据需要自行设定或取消对图层的过滤。

其实这个程序的目的主要是方便插入柱基和承台，尤其是对异形柱框架。

2. 
   
3. ;;;       =============================================
   
4. ;;;       |           自动增加柱形心软件              |
   
5. ;;;       |           Update: 2004.08.12              |
   
6. ;;;       =============================================
   
7. 
   
8. 
   
9. 
   
10. (defun c:zxx (/ e zltx ps si ss)
    
11. 
    
12.   (xdrx_begin "defpoints" '("cmdecho" 0))
    
13.   (princ "\n选择要标记形心的柱子<退出>: ")
    
14.   (if (setq ss (ssget (list '(8 . "柱__框架柱,柱__异框柱,柱__构造柱")
    
15.                             '(0 . "lwpolyline,region")
    
16.                       )
    
17.                )
    
18.       )
    
19.     (progn
    
20.       (setq si 0)
    
21.       (command ".layer" "m" "defpoints" "")
    
22.       (while (setq e (ssname ss si))
    
23.         (setq si  (1+ si))
    
24.         (setq zltx (xdrx_curve_info e))
    
25.         (setq psb (caddr zltx))
    
26.         (setq ps (cadr psb))
    
27.         (command ".point" ps)
    
28.       )
    
29. 
    
30.       (princ
    
31.         "\n程序自动在柱子的形心位置绘制了一个点，方便插入柱基和承台。"
    
32.       )
    
33.     )
    
34.   )
    
35.   (xdrx_end)
    
36. 
    
37. )
    

<br /> ;;;       =============================================<br /> ;;;       |           自动增加柱形心软件              |<br /> ;;;       |           Update: 2004.08.12              |<br /> ;;;       =============================================<br /> <br /> <br /> <br /> (defun c:zxx (/ e zltx ps si ss)<br /> <br />   (xdrx_begin "defpoints" '("cmdecho" 0))<br />   (princ "\n选择要标记形心的柱子<退出>: ")<br />   (if (setq ss (ssget (list '(8 . "柱__框架柱,柱__异框柱,柱__构造柱")<br />                             '(0 . "lwpolyline,region")<br />                       )<br />                )<br />       )<br />     (progn<br />       (setq si 0)<br />       (command ".layer" "m" "defpoints" "")<br />       (while (setq e (ssname ss si))<br />         (setq si  (1+ si))<br />         (setq zltx (xdrx_curve_info e))<br />         (setq psb (caddr zltx))<br />         (setq ps (cadr psb))<br />         (command ".point" ps)<br />       )<br /> <br />       (princ<br />         "\n程序自动在柱子的形心位置绘制了一个点，方便插入柱基和承台。"<br />       )<br />     )<br />   )<br />   (xdrx_end)<br /> <br /> )<br />

yczmc

晕 这么强啊！

它山之石

怎么没人支持我？
其实后来我才发现TSSD2.7里面有更新的柱形心程序，
功能与我的相似。

刚说完，版主就给加了币，太激动了。
看来我应该发布更多的程序与大家共享。

lufeng840317

各位好强啊

jx2008

我最近弄了一个程序，对于不封闭的曲线（spline暂不支持）、实体、面域等均可以求，函数命令qxx,返回值为形心坐标，如果曲线自交，则返回nil

1998966

关注楼上的。

kangbanghua

好想下载

jx2008

请到我的网盘下载
http://muzicad.ys168.com