kinglau 发表于 2006-3-7 14:21:00

进来指点一二,谢谢

<P>我想计算铝型材的外顶点个数,我的想法是把所有图元形成面域,然后比较出最大的面域,统计出此面域的顶点一个,但是我觉得麻烦了点,形成面域后以后又要炸开,有没有更简单点的方法,请指点一二</P>

雪山飞狐_lzh 发表于 2006-3-7 18:08:00

贴图说明一下

kinglau 发表于 2006-3-7 18:37:00

<P>不会发图片,呵呵</P>

雪山飞狐_lzh 发表于 2006-3-7 18:45:00

<P>？</P>
<P></P>

kinglau 发表于 2006-3-7 19:02:00

<P>我编写了一段程序，不过好象有点问题</P>
<P>Sub point()<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim entcount As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim i As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim regcout As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim regionobj As Variant<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim outregion As AcadRegion<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim Selects As AcadSelectionSet<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim p As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim entobj(0 To entcount - 1) As AcadEntity<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim regions(0 To regcount - 1) As Variant<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; entcount = ThisDrawing.ModelSpace.Count<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To entcount - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set entobj(i) = ThisDrawing.ModelSpace.Item(i)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将图上图元付给图元数组<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; regionobj = ThisDrawing.ModelSpace.AddRegion(entobj)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将图元组合成区域<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To entcount - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; entobj(i).Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; regcount = ThisDrawing.ModelSpace.Count<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If regcount = 1 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set outregion = ThisDrawing.ModelSpace.Item(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Do Until regcount = 1<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To regcount - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set regions(i) = ThisDrawing.ModelSpace.Item(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set outregion = regions(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Loop<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 1 To regcount - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If regions(i).Area &gt; outregion.Area Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set outregion = regions(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Selects.AddItems outregion<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each entity In Selects<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If UCase(entity.ObjectName) = "ACDBpoint" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; p = p + 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox p<BR>&nbsp;&nbsp;&nbsp; <BR>End Sub<BR></P>

雪山飞狐_lzh 发表于 2006-3-7 19:10:00

<P>你要获取的到底是什么？</P>
<P>是外部包装尺寸？</P>

kinglau 发表于 2006-3-7 19:13:00

<P></P>
<P>就是要计算最外层的顶点的个数</P>

kinglau 发表于 2006-3-7 19:14:00

只要获得点的个数就可以了

雪山飞狐_lzh 发表于 2006-3-7 19:22:00

<P>图里只有这些图元？</P>
<P>没有其它的？</P>
<P>不用选择么？</P>

雪山飞狐_lzh 发表于 2006-3-7 19:32:00

<P>注意AddRegion返回的是数组！</P>
<P>下面的函数利用AddRegion函数的返回值获取顶点数（和实体数相等）</P>
<P>Private Function GetPointCount(Regions As Variant)<BR>On Error Resume Next<BR>&nbsp;&nbsp;&nbsp;&nbsp; Dim pRegion As AcadRegion<BR>&nbsp;&nbsp;&nbsp;&nbsp; Dim i As AcadEntity<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp; '遍历面域数组找到最大面域<BR>&nbsp;&nbsp;&nbsp;&nbsp; For Each i In Regions<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If pRegion.Area &lt; i.Area Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set pRegion = i<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp; Next i<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp; objs = pRegion.Explode()<BR>&nbsp;&nbsp;&nbsp;&nbsp; GetPointCount = UBound(objs)<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp; For Each i In objs<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i.Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp; Next i<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>End Function<BR></P>
页: [1] 2
查看完整版本: 进来指点一二,谢谢