[求助]：怎么计算多边形的形心

漏网の鱼 · 发表于 2002-5-23 05:58:39

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

面积矩的方法实在不好在计算机上自动实现, 有没有更好的算法?

XDSoft · 发表于 2002-5-23 07:07:19

鱼来了啊：），小鱼儿现在会游泳了吧？

论坛以前讨论过很多次的。

你用ARX写吗？方便的方法，由封闭曲线制作REGION内存模型，然后求REGION的属性就可以了。

LISP也可以用上面方法写，不过过程不太好看：）

XDSoft · 发表于 2002-5-23 07:14:37

下面是求封闭AcDbPolyline的型心的VBA方法（利用REGION）

[FONT=courier new]
Sub GetCentroid()
Dim Doc As AcadDocument
Dim Entity As AcadEntity
Dim Region As AcadRegion
Dim Polylist(0 To 0) As AcadEntity
Dim Entities As AcadModelSpace
Dim nPoly As Integer 'number of polylines
Dim i As Integer
Set Doc = ThisDrawing
Set Entities = Doc.ModelSpace
Dim Centroid As Variant
'Form a region from each polyline
For Each Entity In Entities
If Entity.ObjectName = "AcDbPolyline" Then 'Polyline ?
Set Polylist(0) = Entity
Entities.AddRegion Polylist
MsgBox Entity.ObjectName
End If
Next
'Find centroid of each region
For i = 0 To Entities.Count - 1
If Entities.Item(i).ObjectName = "AcDbRegion" Then 'Region ?
Set Region = Entities.Item(i)
Centroid = Region.Centroid
MsgBox "Centroid X: " & Centroid(0) & vbCrLf & "Centroid Y: " & Centroid(1)
End If
Next
End Sub
[/FONT]

[FONT=courier new] 
Sub GetCentroid() 
 
Dim Doc As AcadDocument 
Dim Entity As AcadEntity 
Dim Region As AcadRegion 
Dim Polylist(0 To 0) As AcadEntity 
Dim Entities As AcadModelSpace 
Dim nPoly As Integer  'number of polylines 
Dim i As Integer 
Set Doc = ThisDrawing 
Set Entities = Doc.ModelSpace 
Dim Centroid As Variant 
 
 
 
'Form a region from each polyline 
For Each Entity In Entities 
 
 If Entity.ObjectName = "AcDbPolyline" Then  'Polyline ? 
    Set Polylist(0) = Entity 
    Entities.AddRegion Polylist 
   MsgBox Entity.ObjectName 
 End If 
   
Next 
 
'Find centroid of each region 
For i = 0 To Entities.Count - 1 
 
 If Entities.Item(i).ObjectName = "AcDbRegion" Then  'Region ? 
    Set Region = Entities.Item(i) 
    Centroid = Region.Centroid 
    MsgBox "Centroid X: " & Centroid(0) & vbCrLf & "Centroid Y: " & Centroid(1) 
 End If 
   
Next 
 
 
End Sub 
[/FONT]

XDSoft · 发表于 2002-5-23 07:23:19

下面是ObjectArx获得AcDb2dPolyline和AcDbPolyline型心的代码：

[FONT=courier new]
void getPolycentroid()
{
ads_name eName;
ads_point pt;
if (RTNORM != acedEntSel("\n选择一个封闭的polyline:",eName,pt))
{
acutPrintf("\nFailed to select entity");
return;
}
AcDbObjectId objId = NULL;
Acad::ErrorStatus es;
es = acdbGetObjectId (objId , eName);
if (Acad::eOk != es)
{
acutPrintf("\nFailed to get object Id");
return;
}
//如果实体不是REGION,那么转换成REGION
AcDbVoidPtrArray curves;
AcDbVoidPtrArray regions;
AcDbEntity *pEnt = NULL;
es =acdbOpenAcDbEntity(pEnt,objId,AcDb::kForRead,Adesk::kFalse);
if(Acad::eOk != es)
{
acutPrintf("\nFailed to open entity for write");
return;
}
//测试实体是AcDbPolyline还是AcDb2dPolyline)
if (! pEnt->isKindOf(AcDb2dPolyline::desc()) &&
!pEnt->isKindOf(AcDbPolyline::desc()))
{
acutPrintf("\nEntity selected is not a polyline");
pEnt->close();
return;
}
if ( pEnt->isKindOf(AcDb2dPolyline::desc()) &&
!((AcDb2dPolyline*)pEnt)->isClosed())
{
acutPrintf("\nPolyline is not closed");
pEnt->close();
return;
}
if ( pEnt->isKindOf(AcDbPolyline::desc()) &&
!((AcDbPolyline*)pEnt)->isClosed())
{
acutPrintf("\nPolyline is not closed");
pEnt->close();
return;
}
curves.append(pEnt);
pEnt->close();
AcDbRegion* pReg;
es=AcDbRegion::createFromCurves(curves,regions);
pReg = AcDbRegion::cast((AcRxObject*)regions[0]);
AcGePoint3d origin;
AcGeVector3d xAxis;
AcGeVector3d yAxis;
AcGePlane plane;
pReg->getPlane(plane);
plane.getCoordSystem(origin, xAxis, yAxis);
double perimeter;
double area;
AcGePoint2d centroid;
double momInertia[2];
double prodInertia;
double prinMoments[2];
AcGeVector2d prinAxes[2];
double radiiGyration[2];
AcGePoint2d extentsLow;
AcGePoint2d extentsHigh;
pReg->getAreaProp(origin,
xAxis,
yAxis,
perimeter,
area,
centroid,
momInertia,
prodInertia,
prinMoments,
prinAxes,
radiiGyration,
extentsLow,
extentsHigh) ;
AcGeVector3d normal;
pReg->getNormal(normal);
pReg->close();
AcGeMatrix3d mat;
mat.setCoordSystem(origin,xAxis,yAxis,normal);
//put point at centriod
AcGePoint3d cpt(centroid[0],centroid[1],0.0);
cpt.transformBy(mat);
resbuf pdm,pds;
pdm.restype = RTSHORT;
pdm.resval.rint = 34;
acedSetVar("PDMODE",&pdm);
pds.restype = RTSHORT;
pds.resval.rint = -5;
acedSetVar("PDSIZE",&pds);
acedCommand(RTSTR,"POINT",RT3DPOINT,asDblArray(cpt),0);
acutPrintf("Centroid=%f,%f",cpt[0],cpt[1]);
}
[/FONT]

复制代码

漏网の鱼 · 发表于 2002-5-23 21:10:35

小鱼儿快2岁了, 现在非常淘气也特别好玩, 下次来北京别忘了给他红包呀:)
"论坛以前讨论过很多次的", 是不是在老论坛里面, 我怎么找不到? 贴一下URL.
另外, 有没有不用REGION的方法, 我正在试图用行列式的方法进行推导, 不过现在数学都还给老师了, 得先补补课.

philroo · 发表于 2002-6-17 20:33:06

XD，你的回复我实在看不懂，这是不是C语言的编程啊？能不能把成品贴上来让我分享一下啊？谢了，因为我用的方法实在太菜了。到现在我还在画对角线来找多边形的形心呢。：）

XDSoft · 发表于 2002-6-17 21:45:57

最初由 philroo 发布
[B]XD，你的回复我实在看不懂，这是不是C语言的编程啊？能不能把成品贴上来让我分享一下啊？谢了，因为我用的方法实在太菜了。到现在我还在画对角线来找多边形的形心呢。：） [/B]

上面三个代码一个是VBA的，一个是ARX的，一个是LISP的。

不知道你是否会用LISP，把上面那个LISP代码拷贝到文件中，把文件存成扩展名为LSP的文件，在ACAD调入这个LISP文件，然后用那个函数就可以了，函数的参数是顶点表。

philroo · 发表于 2002-6-18 15:18:06

XD，我还没接触过LISP，但是看到论坛里面大家都对它这么熟悉，我还非常感兴趣，如果文件不是很大的话告诉我哪里能下载好吗？谢谢了。

PFD8667 · 发表于 2004-7-31 17:29:18

不好意思,函数怎能么调用啊?

shisj · 发表于 2004-8-1 10:18:32

我怎么看不到lsp的版本阿？

redgl · 发表于 2004-8-2 01:02:40

我自己用lisp编写了一个求任意形状图形的形心的程序。它包括求多个任意形状的图形的组合形心，并且会自己会画出形心的位置。
但只能用于2000以上版本。由于是个人用，编写得比较简单。需要加载lisp程序。启动命令为GLA

shisj · 发表于 2004-8-7 09:06:33

你的好像只能求规则面积的形心，不规则的没有办法

xzg_hello · 发表于 2004-8-8 11:01:29

老大，有没有不画图、不选pl实体就根据给定的一组坐标求算出形心的VBA子程序啊

jx2008 · 发表于 2007-6-15 21:25:30

最初由 XDSoft 发布
[B][QUOTE]最初由 philroo 发布
[B]XD，你的回复我实在看不懂，这是不是C语言的编程啊？能不能把成品贴上来让我分享一下啊？谢了，因为我用的方法实在太菜了。到现在我还在画对角线来找多边形的形心呢。：） [/... [/B]

lisp代码在哪里？怎么没有啊？

highflybird · 发表于 2007-6-16 13:03:17

如果求形新的话
用(vla-get-Centroid obj) 就可以了
这是我以前发的一个求形心，惯性矩等截面几何参数的lisp程序。
如果拷贝代码不对的话可以参考
http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=1173

(alert "\n本程序命令为TEST，具体用法如下:
\n单位和精度由ACAD确定，可自己控制，选择封闭线段物体，或者region物体，
\n在提示数据输出方式时，按下P或W键，P代表屏幕输出，W则在C:盘创建数据。
\n请尊重原创者，勿用于商业目的!! Highflybird 2007.1.23 KunMing")
(defun mas (obj / Area Area1 Area2 Perimeter Centroid Centroid1 Centroid2 MomentOfInertia
MomentOfInertia1 PrincipalDirections PrincipalMoments minpt maxpt Sx Sy
ProductOfInertia ProductOfInertia1 RadiiOfGyration Wx1 Wx2 Wy1 Wy2 obj1
obj2 recPt1 recPt2 reg1 reg2 CenX CenY)
(if (= "AcDbRegion" (vla-get-objectname obj)) ;如果是截面则计算
(progn
(setq Area (vla-get-area obj) ;面积
Perimeter (vla-get-Perimeter obj) ;周长
Centroid (V2L (vla-get-Centroid obj)) ;质心
MomentOfInertia (V2L (vla-get-MomentOfInertia obj)) ;惯性矩
PrincipalDirections (V2L (vla-get-PrincipalDirections obj));主矩方向
PrincipalMoments (V2L (vla-get-PrincipalMoments obj)) ;主力矩与质心的X-Y方向
ProductOfInertia (vla-get-ProductOfInertia obj) ;惯性积
) ;setq
(vla-move obj (vlax-3d-point Centroid) (vlax-3d-point '(0 0))) ;移动质心到原点
(setq MomentOfInertia1 (V2L (vla-get-MomentOfInertia obj)) ;质心的惯性矩
ProductOfInertia1 (vla-get-ProductOfInertia obj) ;质心的惯性积
RadiiOfGyration (V2L (vla-get-RadiiOfGyration obj)) ;回旋半径
) ;setq
(vla-getboundingbox obj 'minpt 'maxpt) ;边界框
(setq minpt (vlax-safearray->list minpt) ;左下角点
maxpt (vlax-safearray->list maxpt) ;右上角点
Wx1 (/ (car MomentOfInertia1) (cadr minpt)) ;抵抗矩
Wx2 (/ (car MomentOfInertia1) (cadr maxpt))
Wy1 (/ (cadr MomentOfInertia1) (car minpt))
Wy2 (/ (cadr MomentOfInertia1) (car maxpt))
) ;setq
(vla-move obj (vlax-3d-point '(0 0)) (vlax-3d-point Centroid)) ;移回原来位置
(setq obj1 (vla-copy obj) ;拷贝物体以用来算X面积矩
obj2 (vla-copy obj) ;拷贝物体以用来算Y面积矩
CenX (car Centroid)
CenY (cadr Centroid)
recPt1 (list (+ CenX (car minpt) -1) CenY ;建立两个矩形面域的点表
(+ CenX (car maxpt) +1) CenY
(+ CenX (car maxpt) +1) (+ CenY (cadr minpt) -1)
(+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1))
recPt2 (list (+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1)
(+ CenX (car minpt) -1) (+ CenY (cadr maxpt) +1)
CenX (+ CenY (cadr maxpt) +1)
CenX (+ CenY (cadr minpt) -1))
reg1 (draw-rectange recPt1) ;创建面域1
reg2 (draw-rectange recPt2) ;创建面域2
)
(vla-boolean obj1 acSubtraction reg1) ;求obj1与面域1之差
(vla-boolean obj2 acSubtraction reg2) ;求obj2与面域2之差
(setq Area1 (vla-get-area obj1) ;求obj1的面积
Area2 (vla-get-area obj2) ;求obj2的面积
Centroid1 (V2L (vla-get-Centroid obj1)) ;求obj1的质心
Centroid2 (V2L (vla-get-Centroid obj2)) ;求obj2的质心
Sx (* Area1 (- (cadr Centroid1) (cadr Centroid))) ;绕X轴面积矩（静矩）
Sy (* Area2 (- (car Centroid2) (car Centroid))) ;绕Y轴面积矩（静矩）
)
(vla-delete obj1) ;删除面域1
(vla-delete obj2) ;删除面域2
(list (cons "面积 " Area) ;返回各种参数值
(cons "周长 " Perimeter)
(cons "质心 " Centroid)
(cons "X 轴主惯性矩" (car PrincipalMoments))
(cons "X 轴惯性矩 " (car MomentOfInertia1))
(cons "Y 轴主惯性矩" (cadr PrincipalMoments))
(cons "Y 轴惯性矩 " (cadr MomentOfInertia1))
(cons "XY惯性积 " ProductOfInertia1)
(cons "X 轴上抗弯距" Wx2)
(cons "X 轴下抗弯距" Wx1)
(cons "Y 轴左抗弯距" Wy1)
(cons "Y 轴右抗弯距" Wy2)
(cons "X 轴面积矩 " Sx )
(cons "Y 轴面积矩 " Sy )
(cons "回旋半径ix " (car RadiiOfGyration))
(cons "回旋半径iy " (cadr RadiiOfGyration))
(cons "主矩方向1 " (list (car PrincipalDirections) (caddr PrincipalDirections)))
(cons "主矩方向2 " (list (cadr PrincipalDirections) (cadddr PrincipalDirections)))
(cons "距左边距离 " (abs (car minpt)))
(cons "距右边距离 " (abs (car maxpt)))
(cons "距上边距离 " (abs (cadr maxpt)))
(cons "距下边距离 " (abs (cadr minpt)))
)
)
)
)
;;;用ActiveX的方式画矩形面域
(defun draw-rectange (recpts / pts rec reg)
(setq pts (vlax-make-safearray vlax-vbdouble '(0 . 7)))
(vlax-safearray-fill pts recpts)
(setq rec (vla-addlightweightPolyline *MSP pts));创建矩形
(vla-put-closed rec 1) ;封闭矩形
(setq reg (vla-addregion *MSP (O2L rec))) ;对矩形求面域
(vla-delete rec) ;删除矩形的轻多段线
(car (V2L reg)) ;取得矩形面域物体
)
;;;ActiveX的变量转化为lisp列表
(defun V2L (x)
(vlax-safearray->list (vlax-variant-value x))
)
;;;把选择集的物体转化为安全数组
(defun S2A (ss / i l objs curves)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
)
(setq curves (vlax-make-safearray vlax-vbobject (eval '(cons 0 (1- l)))))
(vlax-safearray-fill curves objs)
)
;;;把选择集的物体转化为Lisp表
(defun S2L (ss / i l objs)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
)
)
;;;物体组成lisp列表
(defun O2L (obj / curves)
(setq curves (vlax-make-safearray vlax-vbobject '(0 . 0)))
(vlax-safearray-fill curves (list obj))
)
;;;打印截面表并计数
(defun GetNum (regobjs Num / Number reglst)
(setq Number Num) ;计数归零
(foreach obj regobjs
(setq reglst (mas obj)) ;对其分别求值
(princ obj) ;打印region名
(princ "\n下面为该物体的参数的列表: ")
(foreach n reglst (princ "\n") (princ n)) ;打印region参数表
(setq Number (1+ Number)) ;计数累加
)
)
;;;表转化成字符串
(defun L2S (lst / s)
(setq s
(apply
'strcat
(mapcar '(lambda(x)(strcat (rtos x) " ")) lst)
)
)
(setq s (substr s 1 (1- (strlen s))))
(strcat "(" s ")")
)
;;;写数据函数
(defun WrData (regobjs Num / Number reglst string str1 str2 str)
(setq Number Num) ;计数归零
(foreach obj regobjs
(setq reglst (mas obj)) ;对其分别求值
(setq Number (1+ Number)) ;计数累加
(write-line "***********************************" file)
(setq string (strcat "截面" (itoa Number) "的参数表:"))
(write-line string file) ;写入region名
(foreach n reglst
(setq str1 (car n)) ;参数名称
(if (listp (setq str2 (cdr n))) ;参数值
(setq str2 (L2S str2))
(setq str2 (rtos str2))
)
(setq str (strcat str1 ": " str2))
(write-line str file) ;写入region参数表
)
)
Number
)
;;;以下测试程序
(defun C:test (/ *APP *DOC *MSP i j ss ss1 err objlst REGs W&P OLDCMD OldUcs file)
(vl-load-com)
(setq *APP (vlax-get-acad-object)
*DOC (vla-get-activeDocument *APP)
*MSP (vla-get-Modelspace *DOC)
)
(princ)
(if (setq ss (ssget)) ;建立选择集
(progn
(initget 1 "W P") ;选择写入文件或屏幕打印
(setq W&P (getkword "\n确定输出数据方式:\n写入文件[W]或屏幕打印[P])?"))
(princ "\n")
(setq OLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;;(command ".UCS" "W")
(uu 1)
(setq objlst (S2A ss)) ;选择集列表
(if (setq ss1 (ssget "P" '((0 . "REGION"))));选择集中已有的region
(setq i (if (= W&P "P") ;计算并求出region数目
(GetNum (S2L ss1) 0)
(progn
(setq file (open "C:\\截面几何参数.TXT""W"));打开文件
(Wrdata (S2L ss1) 0)
)
)
)
(setq i 0)
)
(defun addreg ()
(setq REGs (vla-addregion *MSP objlst))
)
(setq err (vl-catch-all-apply 'addreg)) ;建立区域并出错检测
(if (vl-catch-all-error-p err) ;如果没有新建任何region
(setq j 0) ;则计数为0
(setq REGs (V2L REGs) ;否则转化成region集合
i (if (= W&P "P") ;计算并求出region数目
(GetNum REGs i)
(progn
(setq file (open "C:\\截面几何参数.TXT""A"));打开文件
(Wrdata REGs i)
)
)
j (mapcar 'vla-delete REGs) ;删除刚建立的截面
)
)
(close file) ;关闭文件
(if (/= 0 i)
(progn
(princ "\n\n已经列出")
(princ i)
(princ "个截面几何参数表.")
)
(alert "没有选中有效的截面!")
)
;;(command ".UCS" "P")
(uu 0)
(setvar "CMDECHO" OLDCMD)
)
(alert "你没有选中物体! ")
)
(gc)
(princ)
)
(defun uu (T&F / WCSOrg WCSXDr WCSYDr WCSObj OldOrg OldXDr OldYDr *UTI *UCS)
(setq *UTI (vla-get-Utility *DOC) ;取得Utility集
*UCS (vla-get-UserCoordinateSystems *DOC) ;取得UCS集
)
(setq WCSOrg (vlax-3d-point '(0 0 0))) ;WCS原点
(setq WCSXDr (vlax-3d-point '(1 0 0)))
(setq WCSYDr (vlax-3d-point '(0 1 0)))
(setq WCSObj (vla-add *UCS WCSOrg WCSXDr WCSYDr "WCS"))
(if (= T&F 1)
(progn
(if (= (getvar "UCSNAME") "") ;当前UCS名,如果未命名,则
(progn
(setq OldOrg (vla-GetVariable *DOC "UCSORG") ;取当前UCS原点
OldXDr (vla-getVariable *DOC "UCSXDIR") ;取当前X方向
OldYDr (vla-getVariable *DOC "UCSYDIR") ;取当前Y方向
OldUcs (vla-add *UCS WCSOrg OldXDr OldYDr "OLD");建立当前UCS,但原点在'(0,0,0)处
)
(vla-put-origin OldUcs OldOrg) ;改变原点为当前UCS原点
)
(setq OldUcs (vla-get-ActiveUcs *DOC)) ;如果已经命名,则取得UCS物体
)
(vla-put-ActiveUcs *DOC WCSobj)
)
(vla-put-ActiveUcs *DOC OldUcs)
)
OldUcs
)

(alert "\n本程序命令为TEST，具体用法如下: 
        \n单位和精度由ACAD确定，可自己控制，选择封闭线段物体，或者region物体，           
        \n在提示数据输出方式时，按下P或W键，P代表屏幕输出，W则在C:盘创建数据。 
        \n请尊重原创者，勿用于商业目的!!    Highflybird   2007.1.23  KunMing") 
(defun mas (obj / Area Area1 Area2 Perimeter Centroid Centroid1 Centroid2 MomentOfInertia 
                  MomentOfInertia1 PrincipalDirections PrincipalMoments minpt maxpt Sx Sy 
                  ProductOfInertia ProductOfInertia1 RadiiOfGyration Wx1 Wx2 Wy1 Wy2 obj1 
                  obj2 recPt1 recPt2 reg1 reg2 CenX CenY) 
  (if (= "AcDbRegion" (vla-get-objectname obj))                        ;如果是截面则计算 
    (progn 
      (setq Area (vla-get-area obj)                                    ;面积 
            Perimeter (vla-get-Perimeter obj)                          ;周长 
            Centroid (V2L (vla-get-Centroid obj))                      ;质心 
            MomentOfInertia (V2L (vla-get-MomentOfInertia obj))        ;惯性矩 
            PrincipalDirections (V2L (vla-get-PrincipalDirections obj));主矩方向 
            PrincipalMoments (V2L (vla-get-PrincipalMoments obj))      ;主力矩与质心的X-Y方向 
            ProductOfInertia (vla-get-ProductOfInertia obj)            ;惯性积 
      )                                                                ;setq 
      (vla-move obj (vlax-3d-point Centroid) (vlax-3d-point '(0 0)))   ;移动质心到原点 
      (setq MomentOfInertia1 (V2L (vla-get-MomentOfInertia obj))       ;质心的惯性矩 
            ProductOfInertia1 (vla-get-ProductOfInertia obj)           ;质心的惯性积 
            RadiiOfGyration (V2L (vla-get-RadiiOfGyration obj))        ;回旋半径 
      )                                                                ;setq 
      (vla-getboundingbox obj 'minpt 'maxpt)                           ;边界框 
      (setq minpt (vlax-safearray->list minpt)                         ;左下角点 
            maxpt (vlax-safearray->list maxpt)                         ;右上角点 
            Wx1 (/ (car MomentOfInertia1) (cadr minpt))                ;抵抗矩 
            Wx2 (/ (car MomentOfInertia1) (cadr maxpt)) 
            Wy1 (/ (cadr MomentOfInertia1) (car minpt)) 
            Wy2 (/ (cadr MomentOfInertia1) (car maxpt))                                                   
      )                                                                ;setq 
      (vla-move obj (vlax-3d-point '(0 0)) (vlax-3d-point Centroid))   ;移回原来位置 
      (setq obj1 (vla-copy obj)                                        ;拷贝物体以用来算X面积矩 
            obj2 (vla-copy obj)                                        ;拷贝物体以用来算Y面积矩 
            CenX (car Centroid) 
            CenY (cadr Centroid) 
            recPt1 (list (+ CenX (car minpt) -1) CenY                  ;建立两个矩形面域的点表 
                         (+ CenX (car maxpt) +1) CenY             
                         (+ CenX (car maxpt) +1) (+ CenY (cadr minpt) -1)          
                         (+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1))                                
            recPt2 (list (+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1)                
                         (+ CenX (car minpt) -1) (+ CenY (cadr maxpt) +1)         
                         CenX (+ CenY (cadr maxpt) +1) 
                         CenX (+ CenY (cadr minpt) -1)) 
            reg1 (draw-rectange recPt1)                                ;创建面域1 
            reg2 (draw-rectange recPt2)                                ;创建面域2 
      ) 
      (vla-boolean obj1 acSubtraction reg1)                            ;求obj1与面域1之差 
      (vla-boolean obj2 acSubtraction reg2)                            ;求obj2与面域2之差 
      (setq Area1 (vla-get-area obj1)                                  ;求obj1的面积 
            Area2 (vla-get-area obj2)                                  ;求obj2的面积 
            Centroid1 (V2L (vla-get-Centroid obj1))                    ;求obj1的质心 
            Centroid2 (V2L (vla-get-Centroid obj2))                    ;求obj2的质心 
            Sx (* Area1 (- (cadr Centroid1) (cadr Centroid)))          ;绕X轴面积矩（静矩） 
            Sy (* Area2 (- (car  Centroid2) (car  Centroid)))          ;绕Y轴面积矩（静矩） 
      ) 
      (vla-delete obj1)                                                ;删除面域1 
      (vla-delete obj2)                                                ;删除面域2 
      (list (cons "面积        " Area)                                 ;返回各种参数值 
            (cons "周长        " Perimeter) 
            (cons "质心        " Centroid) 
            (cons "X 轴主惯性矩" (car PrincipalMoments)) 
            (cons "X 轴惯性矩  " (car MomentOfInertia1)) 
            (cons "Y 轴主惯性矩" (cadr PrincipalMoments)) 
            (cons "Y 轴惯性矩  " (cadr MomentOfInertia1)) 
            (cons "XY惯性积    " ProductOfInertia1) 
            (cons "X 轴上抗弯距" Wx2) 
            (cons "X 轴下抗弯距" Wx1) 
            (cons "Y 轴左抗弯距" Wy1) 
            (cons "Y 轴右抗弯距" Wy2) 
            (cons "X 轴面积矩  " Sx ) 
            (cons "Y 轴面积矩  " Sy ) 
            (cons "回旋半径ix  " (car RadiiOfGyration)) 
            (cons "回旋半径iy  " (cadr RadiiOfGyration)) 
            (cons "主矩方向1   " (list (car PrincipalDirections) (caddr PrincipalDirections))) 
            (cons "主矩方向2   " (list (cadr PrincipalDirections) (cadddr PrincipalDirections))) 
            (cons "距左边距离  " (abs (car minpt))) 
            (cons "距右边距离  " (abs (car maxpt))) 
            (cons "距上边距离  " (abs (cadr maxpt))) 
            (cons "距下边距离  " (abs (cadr minpt))) 
      ) 
    ) 
  ) 
) 
;;;用ActiveX的方式画矩形面域 
(defun draw-rectange (recpts / pts rec reg) 
  (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 7))) 
  (vlax-safearray-fill pts recpts) 
  (setq rec (vla-addlightweightPolyline *MSP pts));创建矩形 
  (vla-put-closed rec 1)                          ;封闭矩形 
  (setq reg (vla-addregion *MSP (O2L rec)))       ;对矩形求面域 
  (vla-delete rec)                                  ;删除矩形的轻多段线 
  (car (V2L reg))                                 ;取得矩形面域物体 
) 
;;;ActiveX的变量转化为lisp列表 
(defun V2L (x) 
  (vlax-safearray->list (vlax-variant-value x)) 
) 
;;;把选择集的物体转化为安全数组 
(defun S2A (ss / i l objs curves) 
  (setq i -1 l (sslength ss) objs nil) 
  (repeat l 
    (setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs)) 
  ) 
  (setq curves (vlax-make-safearray vlax-vbobject (eval '(cons 0 (1- l))))) 
  (vlax-safearray-fill curves objs) 
) 
;;;把选择集的物体转化为Lisp表 
(defun S2L (ss / i l objs) 
  (setq i -1 l (sslength ss) objs nil) 
  (repeat l 
    (setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs)) 
  ) 
) 
;;;物体组成lisp列表 
(defun O2L (obj / curves) 
  (setq curves (vlax-make-safearray vlax-vbobject '(0 . 0))) 
  (vlax-safearray-fill curves (list obj)) 
) 
;;;打印截面表并计数 
(defun GetNum (regobjs Num / Number reglst) 
  (setq Number Num)                               ;计数归零 
  (foreach obj regobjs                                   
    (setq reglst (mas obj))                       ;对其分别求值 
    (princ obj)                                          ;打印region名 
    (princ "\n下面为该物体的参数的列表: ") 
    (foreach n reglst (princ "\n") (princ n))     ;打印region参数表 
    (setq Number (1+ Number))                     ;计数累加 
  ) 
) 
;;;表转化成字符串 
(defun L2S (lst / s) 
  (setq        s 
         (apply 
           'strcat 
           (mapcar '(lambda(x)(strcat (rtos x) " ")) lst) 
         ) 
  ) 
  (setq s (substr s 1 (1- (strlen s)))) 
  (strcat "(" s ")") 
) 
;;;写数据函数 
(defun WrData (regobjs Num / Number reglst string str1 str2 str) 
  (setq Number Num)                               ;计数归零 
  (foreach obj regobjs                                   
    (setq reglst (mas obj))                       ;对其分别求值 
    (setq Number (1+ Number))                     ;计数累加 
    (write-line "***********************************" file) 
    (setq string (strcat "截面" (itoa Number) "的参数表:")) 
    (write-line string file)                      ;写入region名 
    (foreach n reglst 
      (setq str1 (car n))                         ;参数名称 
      (if (listp (setq str2 (cdr n)))             ;参数值 
        (setq str2 (L2S str2))          
        (setq str2 (rtos str2)) 
      ) 
      (setq str (strcat str1 ": " str2)) 
      (write-line str file)                       ;写入region参数表 
    )                                              
  ) 
  Number 
) 
;;;以下测试程序 
(defun C:test (/ *APP *DOC *MSP i j ss ss1 err objlst REGs W&P OLDCMD OldUcs file) 
  (vl-load-com) 
  (setq        *APP (vlax-get-acad-object) 
        *DOC (vla-get-activeDocument *APP) 
        *MSP (vla-get-Modelspace *DOC) 
  ) 
  (princ) 
  (if (setq ss (ssget))                           ;建立选择集 
    (progn 
      (initget 1 "W P")                           ;选择写入文件或屏幕打印 
      (setq W&P (getkword "\n确定输出数据方式:\n写入文件[W]或屏幕打印[P])?")) 
      (princ "\n")    
      (setq OLDCMD (getvar "CMDECHO")) 
      (setvar "CMDECHO" 0) 
      ;;(command ".UCS" "W") 
      (uu 1) 
      (setq objlst (S2A ss))                      ;选择集列表 
      (if (setq ss1 (ssget "P" '((0 . "REGION"))));选择集中已有的region 
        (setq i (if (= W&P "P")                   ;计算并求出region数目 
                  (GetNum (S2L ss1) 0) 
                  (progn 
                    (setq file (open "C:\\截面几何参数.TXT""W"));打开文件 
                    (Wrdata (S2L ss1) 0) 
                  ) 
                ) 
        ) 
        (setq i 0) 
      )                            
      (defun addreg () 
        (setq REGs (vla-addregion *MSP objlst)) 
      ) 
      (setq err (vl-catch-all-apply 'addreg))     ;建立区域并出错检测 
      (if (vl-catch-all-error-p err)              ;如果没有新建任何region 
        (setq j 0)                                ;则计数为0 
        (setq REGs (V2L REGs)                     ;否则转化成region集合 
              i (if (= W&P "P")                   ;计算并求出region数目 
                  (GetNum REGs i) 
                  (progn 
                    (setq file (open "C:\\截面几何参数.TXT""A"));打开文件 
                    (Wrdata REGs i) 
                  ) 
                ) 
              j (mapcar 'vla-delete REGs)         ;删除刚建立的截面 
        ) 
      ) 
      (close file)                                ;关闭文件 
      (if (/= 0 i) 
        (progn 
          (princ "\n\n已经列出") 
          (princ i) 
          (princ "个截面几何参数表.") 
        ) 
        (alert "没有选中有效的截面!") 
      ) 
      ;;(command ".UCS" "P") 
      (uu 0) 
      (setvar "CMDECHO" OLDCMD) 
    ) 
    (alert "你没有选中物体! ") 
  ) 
  (gc) 
  (princ) 
) 
(defun uu (T&F / WCSOrg WCSXDr WCSYDr WCSObj OldOrg OldXDr OldYDr *UTI *UCS) 
  (setq *UTI (vla-get-Utility *DOC)                             ;取得Utility集 
        *UCS (vla-get-UserCoordinateSystems *DOC)               ;取得UCS集 
  ) 
  (setq WCSOrg (vlax-3d-point '(0 0 0)))                        ;WCS原点 
  (setq WCSXDr (vlax-3d-point '(1 0 0))) 
  (setq WCSYDr (vlax-3d-point '(0 1 0))) 
  (setq WCSObj (vla-add *UCS WCSOrg  WCSXDr WCSYDr "WCS")) 
  (if (= T&F 1) 
    (progn 
      (if (= (getvar "UCSNAME") "")                             ;当前UCS名,如果未命名,则 
        (progn 
          (setq OldOrg (vla-GetVariable *DOC "UCSORG")          ;取当前UCS原点 
                  OldXDr (vla-getVariable *DOC "UCSXDIR")         ;取当前X方向 
                OldYDr (vla-getVariable *DOC "UCSYDIR")         ;取当前Y方向 
                OldUcs (vla-add *UCS WCSOrg OldXDr OldYDr "OLD");建立当前UCS,但原点在'(0,0,0)处 
          ) 
          (vla-put-origin OldUcs OldOrg)                        ;改变原点为当前UCS原点 
        ) 
        (setq OldUcs (vla-get-ActiveUcs *DOC))                  ;如果已经命名,则取得UCS物体 
      ) 
      (vla-put-ActiveUcs *DOC WCSobj) 
    ) 
    (vla-put-ActiveUcs *DOC OldUcs)    
  ) 
  OldUcs 
)

账号		自动登录	找回密码
密码			立即注册

[求助]：怎么计算多边形的形心

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块