现在提取的截面特性第一个面域，第二个面域都正确,求并集后的截面特性提取错误，在求并集过程中如果先选择第一个面域，求并集后提取的截面特性就为第一个面域的，反之，在求并集过程中如果先选择第二个面域，求并集后提取的截面特性就为第二个面域的，实际我们求并集后需提取的截面特性为求并集后的截面特性。但不希望在求完并集后再次单选择求并集后的截面去提取并集后截面特性。
源代码如下：
公共变量设置：Public Ix0 As Double, Iy0 As DoublePublic Ix1 As Double, Iy1 As DoublePublic Ix2 As Double, Iy2 As DoublePublic Wx10 As Double, Wx20 As DoublePublic Wx11 As Double, Wx21 As DoublePublic Wx12 As Double, Wx22 As DoublePublic Wy10 As Double, Wy20 As DoublePublic Wy11 As Double, Wy21 As DoublePublic Wy12 As Double, Wy22 As DoublePublic Sx0 As Double, Sy0 As DoublePublic Sx1 As Double, Sy1 As DoublePublic Sx2 As Double, Sy2 As DoublePublic A0 As Double, A1 As Double, A2 AsDouble计算部分源代码：Private Sub Command15_Click()'选择对像Form1.HideDim MyEnty As AcadEntity, basPoint AsVariantDim MySel As AcadSelectionSetDim MinPoAs Variant, MaxPo As VariantDim LeftPo(2) As Double, RightPo(2) AsDoubleCall formTotop(acadApp.hwnd)'提示用户选择On Error Resume NextReSele:MsgBox "请选择断热条一侧的面域部分!", vbOKOnly, "说明" ‘选择第一个面域acadDoc.Utility.GetEntity MyEnty, basPoint,"选择对象:"If Err.Number <> 0 Then If CheckKey(VK_ESCAPE) = True Or CheckKey(VK_MRight) = True Then Me.Show Exit Sub Else GoTo ReSele End IfEnd IfIf Not (MyEnty Is Nothing) Then If MyEnty.ObjectName = "AcDbRegion" Then '计算特性 Call Xcdm(acadDoc, MyEnty) ‘提取第一个面域的截面特性 A0 = Round(SS * 100, 3) 第一个面域的截面特性输入公共变量中 Ix0 = Round(IIx, 3) Iy0 = Round(IIy, 3) Wx10 = Round(WWx1, 3) Wx20 = Round(WWx2, 3) Wy10 = Round(WWy1, 3) Wy20 = Round(WWy2, 3) If SSx1≤SSx2 Then Sx0 = Round(SSx1, 3) Else Sx0 = Round(SSx2, 3) End If If SSy1≤SSy2 Then Sy0 = Round(SSy1, 3) Else Sy0 = Round(SSy2, 3) End If Else MsgBox "当前选择对像不是一个面域,请重新选择!",vbOKOnly, "运行提示" End IfEnd IfMsgBox "请选择断热条另一侧的面域部分!", vbOKOnly, "说明"‘选择第二个面域acadDoc.Utility.GetEntity MyEnty, basPoint,"选择对象:"If Err.Number <> 0 Then If CheckKey(VK_ESCAPE) = True Or CheckKey(VK_MRight) = True Then Me.Show Exit Sub Else GoTo ReSele End IfEnd IfIf Not (MyEnty Is Nothing) Then If MyEnty.ObjectName = "AcDbRegion" Then '计算特性 Call Xcdm(acadDoc, MyEnty) ‘提取第二个面域的截面特性 A1 = Round(SS * 100, 3) 第一个面域的截面特性输入公共变量中 Ix1 = Round(IIx, 3) Iy1 = Round(IIy, 3) Wx11 = Round(WWx1, 3) Wx21 = Round(WWx2, 3) Wy11 = Round(WWy1, 3) Wy21 = Round(WWy2, 3) If SSx1≤SSx2 Then Sx1 = Round(SSx1, 3) Else Sx1 = Round(SSx2, 3) End If If SSy1≤SSy2 Then Sy1 = Round(SSy1, 3) Else Sy1 = Round(SSy2, 3) End If Else MsgBox "当前选择对像不是一个面域,请重新选择!",vbOKOnly, "运行提示" End IfEnd IfMsgBox "请选择断热条及铝合金的全部面域部分!", vbOKOnly, "说明" ‘将第一、二个面域及隔热条求并集 Dim RoomObjects(0 To 2) As AcadRegion Dim curvers() As AcadEntity Dim ssetobj As AcadSelectionSet On Error Resume Next Set ssetobj =acadApp.ActiveDocument.SelectionSets.Add("example") If Err Then Set ssetobj = acadApp.ActiveDocument.SelectionSets.Item("example") ssetobj.Clear Err.Clear End If Dim FT(6) As Integer, FD(6) As Variant, E As AcadEntity, I As Integer, JAs Integer, K As Integer FT(0) = -4: FD(0) = "<OR" FT(1) = 0: FD(1) = "Circle" FT(2) = 0: FD(2) = "Ellipse" FT(3) = 0: FD(3) = "LWPolyline" FT(4) = 0: FD(4) = "SPLine" FT(5) = 0: FD(5) = "Region" FT(6) = -4: FD(6) ="OR>" ssetobj.SelectOnScreen FT, FD For Each E In ssetobj If E.ObjectName = "AcDbRegion" Then Set RoomObjects(I) = E I = I + 1 Else ReDim Preserve curvers(J) Set curvers(J) = E J = J + 1 End If Next ssetobj.Delete Dim regions As Variant If I < 3 Then regions = acadApp.ActiveDocument.ModelSpace.AddRegion(curvers) If Err Then MsgBox "边界错误", vbCritical, "AutoCAD" Exit Sub End If End If For J = I To 2 Set RoomObjects(J) = regions(J - I) Next For I = 1 To 2 RoomObjects(0).Boolean acUnion, RoomObjects(I) Next ZoomExtentsIf Err.Number <> 0 Then If CheckKey(VK_ESCAPE) = True Or CheckKey(VK_MRight) = True Then Me.Show Exit Sub Else GoTo ReSele End IfEnd IfIf Not (MyEnty Is Nothing) Then If MyEnty.ObjectName = "AcDbRegion" Then '计算特性 Call Xcdm(acadDoc, MyEnty) 提取求并集后的截面特性 A2 = Round(SS * 100, 3) 求并集后面域的截面特性输入公共变量中 Ix2 = Round(IIx, 3) Iy2 = Round(IIy, 3) Wx12 = Round(WWx1, 3) Wx22 = Round(WWx2, 3) Wy12 = Round(WWy1, 3) Wy22 = Round(WWy2, 3) If SSx1≤SSx2 Then Sx2 = Round(SSx1, 3) Else Sx2 = Round(SSx2, 3) End If If SSy1≤SSy2 Then Sy2 = Round(SSy1, 3) Else Sy2 = Round(SSy2, 3) End If Else MsgBox "当前选择对像不是一个面域,请重新选择!",vbOKOnly, "运行提示" End IfEnd If 通过文本栏输出提取的截面特性（可以提取第一个面域特性，第二个面域特性及求并集后的面域特性） Text9.Text = A1 Text1.Text = Ix1 Text2.Text = Iy1 Text3.Text = Wx11 Text4.Text = Wx21 Text5.Text = Wy11 Text6.Text = Wy21 If SSx1≤SSx2 Then Text7.Text = Sx1 Else Text7.Text = Sx1 End If If SSy1≤SSy2 Then Text8.Text = Sy1 Else Text8.Text = Sy1 End IfForm1.ShowEnd Sub 问题解决啦!新手提的问题比较模糊,见谅!谢谢大家! woaishuijia 发表于 2013-10-2 16:24
本以为你这段代码是试验用的,只针对特殊情况.原来你在做面域这一步就理解错了
下面详细剖析一下你这段代码 ...
老师太热心了！感谢老师的答疑解惑。
页:
1
[2]