[求助]我写了一段程序，需要高手修改！

yeqb4749659

Sub q()
'排除同名选择集
Dim ii As Single
ii = ThisDrawing.SelectionSets.Count
While (ii > 0)
Set sset = ThisDrawing.SelectionSets.Item(ii - 1)
If sset.Name = "newset" Then
sset.Delete
End If
ii = ii - 1
Wend
'建立新选择集
ThisDrawing.Utility.Prompt ("请选择区域")
 Set tempset = ThisDrawing.SelectionSets.Add("newset")
  '用户在屏幕上选择
      tempset.SelectOnScreen
 Dim point1 As Variant
    Dim point2 As Variant
    ' 获取用户输入的点
    ThisDrawing.Utility.Prompt ("请绘制剖切线")
    point1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "First point: ")
    point2 = ThisDrawing.Utility.GetPoint _
    (point1, vbCrLf & "Second point: ")
     Set Line = ThisDrawing.ModelSpace.AddLine(point1, point2)
   '打开记事本
Open "C:\Documents and Settings\Administrator\桌面\科技立项\123.txt" For Append As #1
'求直线与选择集的交点
Dim point11(0 To 2) As Double
Dim point22(0 To 2) As Double

point11(0) = point1(0)
point11(1) = point1(1)
point22(0) = point2(0)
point22(1) = point2(1)
For n = 50 To 91
top:

If n >= 91 Then
MsgBox ("采点结束")
End

End If
point11(2) = n
point22(2) = n

Dim linex As Object
Set linex = ThisDrawing.ModelSpace.AddLine(point11, point22)
Dim intPoints As Variant
Dim m As Integer
Dim ent As Object
Dim kk As String

For Each ent In tempset
   intPoints = linex.IntersectWith(ent, acExtendNone)
    For m = 0 To UBound(intPoints)
        kk = kk & " " & Round(intPoints(m), 3)      '确定坐标的精确度
    Next m
   
Next ent

kk = Trim(kk)
'打印出所有交点
Dim a() As String

t = UBound(Split(kk))
If t = -1 Then
kk = ""
n = n + 1
GoTo top
End If
ReDim a(0 To t)
a = Split(kk)
Dim I As Integer, j As Integer, k As Integer

    If VarType(Split(kk)) <> vbEmpty Then
        For I = LBound(Split(kk)) To UBound(Split(kk))  'split函数是将字符串按分隔符或空格分成字符数组
            Print #1, k & " " & a(j) & " " & a(j + 1) & " " & a(j + 2)
            I = I + 2
            j = j + 3
            k = k + 1
        Next I
     End If
 
    kk = ""
     I = 0
    j = 0
    k = 0
   For I = 0 To t
   a(I) = ""
   Next I
    Next n
  tempset.Delete
    Close #1
End Sub

此程序用于求出剖切线与等高线的交点，并将交点的坐标输出。

可当选择集的元素太多时，程序就不能运行。cad就未响应。

敬请高手帮忙1

yeqb4749659

没有人反应，郁闷ing……

ljq

不要进行字符串操作,直接进行文件操作.大致如下:

For Each ent In tempset
   intPoints = linex.IntersectWith(ent, acExtendNone)
    For m = 1 To (UBound(intPoints)+1)/3
        xx =  Round(intPoints(3*m-3), 3)      '确定坐标的精确度

        yy =  Round(intPoints(3*m-3), 3)      '确定坐标的精确度

        zz =  Round(intPoints(3*m-3), 3)      '确定坐标的精确度

        Print #1, k & " " & xx & " " & yy & " " & zz

        k=k+1
    Next m
   
Next ent

  Close #1

你还没有考虑点在线上的位置,还不能画真正剖线.

yeqb4749659

ljq :

谢谢你的回复！但我怎么考虑点在不在线上呢？？？真正的画出剖切线的思路是怎样？？期待你的赐教!

ljq

你得到的点已经在剖线上了，只是还不能画出剖面线，对点进行排序就可以了．