xiongchen 发表于 2007-4-21 14:09:00

用Vlax、Curve类离散地形等高线为文字为什么有时会自动退出ACAD

<p>运用Vlax、Curve类 写了一个离散等高线为文字的函数，但性能不稳定，有时多选几条等高线后会出现参数过多的提示或自动退出ACAD，请大侠帮忙看看问题何在？拜托！</p><p>Sub dgx_text()<br/>&nbsp;&nbsp;&nbsp; '定义选择集<br/>&nbsp;&nbsp;&nbsp; Dim SsetObj As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim FilterType(0 To 1) As Integer<br/>&nbsp;&nbsp;&nbsp; Dim FilterData(0 To 1) As Variant<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '定义循环变量<br/>&nbsp;&nbsp;&nbsp; Dim N As Long<br/>&nbsp;&nbsp;&nbsp; Dim I As Long, J As Long, K As Long, II As Long, JJ As Long<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '定义文字变量<br/>&nbsp;&nbsp;&nbsp; Dim High As Double<br/>&nbsp;&nbsp;&nbsp; Dim XText As AcadText<br/>&nbsp;&nbsp;&nbsp; Dim insPt(0 To 2) As Double<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; '定义引用曲线类模块<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim ObjCurve As Curve<br/>&nbsp;&nbsp;&nbsp;&nbsp; Set ObjCurve = New Curve<br/>&nbsp;&nbsp;&nbsp;&nbsp; '获取曲线变量<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim sPt As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim ePt As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim Pt As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim ENT As AcadEntity<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '配置参数<br/>&nbsp;&nbsp;&nbsp; Dim Dist As Double<br/>&nbsp;&nbsp;&nbsp; Dim Htext As Double<br/>&nbsp;&nbsp;&nbsp; Dim Color1 As Integer<br/>&nbsp;&nbsp;&nbsp; Dim Color2 As Integer<br/>&nbsp;&nbsp;&nbsp; Dim Color3 As Integer<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; 'Op.Show<br/>&nbsp;&nbsp;&nbsp; 'Dist = Val(Op.TextBox1.Text)<br/>&nbsp;&nbsp;&nbsp; 'Htext = Val(Op.TextBox2.Text)<br/>&nbsp;&nbsp;&nbsp; 'Color1 = Val(Op.TextBox3.Text)<br/>&nbsp;&nbsp;&nbsp; 'Color2 = Val(Op.TextBox4.Text)<br/>&nbsp;&nbsp;&nbsp; Dist = 5<br/>&nbsp;&nbsp;&nbsp; Htext = 1<br/>&nbsp;&nbsp;&nbsp; Color1 = 3<br/>&nbsp;&nbsp;&nbsp; Color2 = 1<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '选择曲线<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Add("b")<br/>&nbsp;&nbsp;&nbsp; If Err Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Item("b")<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; SsetObj.Clear<br/>&nbsp;&nbsp;&nbsp; SsetObj.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp; N = SsetObj.Count<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim Length As Double<br/>&nbsp;&nbsp;&nbsp; Dim mLength As Double<br/>&nbsp;&nbsp;&nbsp; '循环选择对象<br/>&nbsp;&nbsp;&nbsp; For I = 0 To N - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If SsetObj.Item(I).ObjectName = "AcDbLine" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbCircle" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbArc" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbSpline" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDb3dPolyline" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbPolyline" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDb2dPolyline" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbEllipse" Or _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).ObjectName = "AcDbLeader" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If SsetObj.Item(I).ObjectName = "AcDbLine" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).StartPoint()(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDbCircle" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).CenterPoint()(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDbArc" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).CenterPoint()(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDbSpline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).ControlPoints(0)(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDb3dPolyline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).Coordinates()(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDbPolyline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).Elevation<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf SsetObj.Item(I).ObjectName = "AcDb2dPolyline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = SsetObj.Item(I).Elevation<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ENT = SsetObj.Item(I)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '亮显要处理的曲线以方便输入曲线代表高程<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Color3 = SsetObj.Item(I).color<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).color = Color1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).Update<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ENT.Highlight True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If High &lt;= 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = ThisDrawing.Utility.GetReal("输入等高线高程：")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If High &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ObjCurve.Entity = ENT<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sPt = ObjCurve.StartPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ePt = ObjCurve.EndPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Length = ObjCurve.Length<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.ModelSpace.AddText Trim(Str(High)), sPt, Htext<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.ModelSpace.AddText Trim(Str(High)), ePt, Htext<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Length &gt; Dist Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; mLength = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Do<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; mLength = mLength + Dist<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If mLength &lt; Length Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Pt = ObjCurve.GetPointAtDistance(mLength)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.ModelSpace.AddText Trim(Str(High)), Pt, Htext<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Do<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Loop<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ENT.Highlight False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).color = Color2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; High = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Item(I).color = Color3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next I<br/>&nbsp;&nbsp;&nbsp; SsetObj.Clear<br/>End Sub</p>
页: [1]
查看完整版本: 用Vlax、Curve类离散地形等高线为文字为什么有时会自动退出ACAD