[求助]我写了一段程序，需要高手修改！
<p>Sub q()<br/>'排除同名选择集<br/>Dim ii As Single<br/>ii = ThisDrawing.SelectionSets.Count<br/>While (ii > 0)<br/>Set sset = ThisDrawing.SelectionSets.Item(ii - 1)<br/>If sset.Name = "newset" Then<br/>sset.Delete<br/>End If<br/>ii = ii - 1<br/>Wend<br/>'建立新选择集<br/>ThisDrawing.Utility.Prompt ("请选择区域")<br/> Set tempset = ThisDrawing.SelectionSets.Add("newset")<br/> '用户在屏幕上选择<br/> tempset.SelectOnScreen<br/> Dim point1 As Variant<br/> Dim point2 As Variant<br/> ' 获取用户输入的点<br/> ThisDrawing.Utility.Prompt ("请绘制剖切线")<br/> point1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "First point: ")<br/> point2 = ThisDrawing.Utility.GetPoint _<br/> (point1, vbCrLf & "Second point: ")<br/> Set Line = ThisDrawing.ModelSpace.AddLine(point1, point2)<br/> '打开记事本<br/>Open "C:\Documents and Settings\Administrator\桌面\科技立项\123.txt" For Append As #1<br/>'求直线与选择集的交点<br/>Dim point11(0 To 2) As Double<br/>Dim point22(0 To 2) As Double</p><p>point11(0) = point1(0)<br/>point11(1) = point1(1)<br/>point22(0) = point2(0)<br/>point22(1) = point2(1)<br/>For n = 50 To 91<br/>top:</p><p>If n >= 91 Then<br/>MsgBox ("采点结束")<br/>End</p><p>End If<br/>point11(2) = n<br/>point22(2) = n</p><p>Dim linex As Object<br/>Set linex = ThisDrawing.ModelSpace.AddLine(point11, point22)<br/>Dim intPoints As Variant<br/>Dim m As Integer<br/>Dim ent As Object<br/>Dim kk As String</p><p>For Each ent In tempset<br/> intPoints = linex.IntersectWith(ent, acExtendNone)<br/> For m = 0 To UBound(intPoints)<br/> kk = kk & " " & Round(intPoints(m), 3) '确定坐标的精确度<br/> Next m<br/> <br/>Next ent</p><p>kk = Trim(kk)<br/>'打印出所有交点<br/>Dim a() As String</p><p>t = UBound(Split(kk))<br/>If t = -1 Then<br/>kk = ""<br/>n = n + 1<br/>GoTo top<br/>End If<br/>ReDim a(0 To t)<br/>a = Split(kk)<br/>Dim I As Integer, j As Integer, k As Integer</p><p> If VarType(Split(kk)) <> vbEmpty Then<br/> For I = LBound(Split(kk)) To UBound(Split(kk)) 'split函数是将字符串按分隔符或空格分成字符数组<br/> Print #1, k & " " & a(j) & " " & a(j + 1) & " " & a(j + 2)<br/> I = I + 2<br/> j = j + 3<br/> k = k + 1<br/> Next I<br/> End If<br/> <br/> kk = ""<br/> I = 0<br/> j = 0<br/> k = 0<br/> For I = 0 To t<br/> a(I) = ""<br/> Next I<br/> Next n<br/> tempset.Delete<br/> Close #1<br/>End Sub</p><p>此程序用于求出剖切线与等高线的交点，并将交点的坐标输出。</p><p>可当选择集的元素太多时，程序就不能运行。cad就未响应。</p><p>敬请高手帮忙1</p> <p>没有人反应，郁闷ing……</p> <p>不要进行字符串操作,直接进行文件操作.大致如下:</p><p>For Each ent In tempset<br/> intPoints = linex.IntersectWith(ent, acExtendNone)<br/> For m = 1 To (UBound(intPoints)+1)/3<br/> xx = Round(intPoints(3*m-3), 3) '确定坐标的精确度</p><p> yy = Round(intPoints(3*m-3), 3) '确定坐标的精确度</p><p> zz = Round(intPoints(3*m-3), 3) '确定坐标的精确度</p><p> Print #1, k & " " & xx & " " & yy & " " & zz</p><p> k=k+1<br/> Next m<br/> <br/>Next ent</p><p> Close #1<br/></p><p>你还没有考虑点在线上的位置,还不能画真正剖线.</p> <p>ljq :</p><p>谢谢你的回复！但我怎么考虑点在不在线上呢？？？真正的画出剖切线的思路是怎样？？期待你的赐教!<br/></p> <p>你得到的点已经在剖线上了，只是还不能画出剖面线，对点进行排序就可以了．</p>
页:
[1]