ywy6688 发表于 2005-9-28 15:14:00

请教斑主及各位大虾与面域有关的问题

<P>斑主及大虾们:</P>
<P>&nbsp; 本人对VBA+CAD只知皮毛,&nbsp;&nbsp; 附图中的AB两个问题能解决吗?,怎么解决??</P>
<P>&nbsp; 求求各位了,国庆长假我作东</P>

songzhi 发表于 2005-9-28 21:01:00

<P>Sub getArea()</P>
<P>&nbsp;&nbsp;&nbsp; Dim objEnts()&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As AcadEntity<BR>&nbsp;&nbsp;&nbsp; Dim objEnt&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As AcadEntity<BR>&nbsp;&nbsp;&nbsp; Dim ssSet&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As AcadSelectionSet<BR>&nbsp;&nbsp;&nbsp; Dim iCount&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long<BR>&nbsp;&nbsp;&nbsp; Dim lngCount&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Long<BR>&nbsp;&nbsp;&nbsp; Dim objRegion1&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Variant<BR>&nbsp;&nbsp;&nbsp; Dim objRegion&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As AcadRegion</P>
<P><BR>&nbsp;&nbsp;&nbsp; lngCount = ThisDrawing.SelectionSets.Count<BR>&nbsp;&nbsp;&nbsp; If lngCount &gt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For iCount = lngCount - 1 To 0 Step -1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ssSet = ThisDrawing.SelectionSets(iCount)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ssSet.Name = "SSSS" Then ssSet.Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp; End If</P>
<P><BR>&nbsp;&nbsp;&nbsp; Set ssSet = ThisDrawing.SelectionSets.Add("SSSS")</P>
<P>&nbsp;&nbsp;&nbsp; ssSet.SelectOnScreen<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; lngCount = ssSet.Count<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; If lngCount &gt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim objEnts(0 To lngCount - 1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For iCount = 0 To lngCount - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objEnts(iCount) = ssSet(iCount)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; objRegion1 = ThisDrawing.ModelSpace.AddRegion(objEnts)<BR>&nbsp;&nbsp;&nbsp; For iCount = LBound(objRegion1) To UBound(objRegion1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objRegion = objRegion1(iCount)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'dblArea1 = dblArea1 + objRegion.Area</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox&nbsp;Cstr(objRegion.Area)<BR>&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp; ssSet.Delete<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Set objEnt = Nothing<BR>&nbsp;&nbsp;&nbsp; Set ssSet = Nothing<BR>&nbsp;&nbsp;&nbsp; Set objRegion = Nothing<BR>&nbsp;&nbsp;&nbsp; <BR>End Sub<BR></P>

songzhi 发表于 2005-9-28 21:40:00

<P>问题B也是比较简单的，既然你有各点的坐标，先把圆弧也当成直线加入到轻量多段线中去，然后设置它的凸度就可以了。凸度计算公式是2*H/D,D为弦长，H为圆弧顶点到弦的距离。逆时针取正值，顺时针取负值。</P>
<P>以下代码画一段轻量多段线，第二段为圆弧：</P>
<P>Sub test()</P>
<P>&nbsp;&nbsp;&nbsp; Dim oLSP&nbsp;&nbsp;&nbsp; As AcadLWPolyline<BR>&nbsp;&nbsp;&nbsp; Dim p(0 To 7) As Double<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; p(0) = 0#: p(1) = 0#<BR>&nbsp;&nbsp;&nbsp; p(2) = 100#: p(3) = 0#<BR>&nbsp;&nbsp;&nbsp; p(4) = 100#: p(5) = 100#<BR>&nbsp;&nbsp;&nbsp; p(6) = 0#: p(7) = 100#<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Set oLSP = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; oLSP.SetBulge 1, 1<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Set oLSP = Nothing</P>
<P>&nbsp;&nbsp;&nbsp; <BR>End Sub<BR></P>

ywy6688 发表于 2005-10-11 14:27:00

<P>非常感谢<A name=59625><FONT color=#000066><B>songzhi</B></FONT></A>&nbsp;第二个问题已解决.</P>
<P>第一个问题通过屏幕选择相关的对象后,运行到</P>
<P>&nbsp;objRegion1 = cad2.ModelSpace.AddRegion(objEnts) 这句时出现错误:</P>
<P>实时错误'-2147418113(8000ffff)':</P>
<P>对象'Addregion' 的方法IAcadModeSpace'失败</P>
<P>还望赐教</P>

songzhi 发表于 2005-10-12 22:04:00

上面的代码我是在ACAD2004 的VBA环境下测试的,没有在VB下试过。你说的问题我搜索了一下网上的相关资料。据资料介绍你可以编译后再试试看!

小美菜 发表于 2005-11-21 22:50:00

<P>用 ThisDrawing.SendCommand Chr(3) &amp; Chr(3) &amp; "-boundary" &amp; vbCr &amp; basePMN(0) &amp; "," &amp; basePMN(1) &amp; vbCr &amp; vbCr</P>
<P>可以自动生成一闭合多义线，即可求面积！</P>
页: [1]
查看完整版本: 请教斑主及各位大虾与面域有关的问题