南Sir你好，请放贵眼看来

win171

第三问题 ：务必请南Sir回忆一下，能够提供简单示例代码最好，提供具体参考地址也可。
第一问题 ：南Sir可以做一个最简单的示例。在窗体的事件中仅仅建立选择集，不作任何其他工作，你试一下，可以发现单步运行正常，F5运行跳过selectOnScreen.
具体代码可以参考第二问题中的VB代码。

第二问题 ：请在cad中预先画出任意图元
Option Explicit
Dim A2000 As AcadApplication
Dim SSET As AcadSelectionSet

Private Sub Command1_Click()
Dim i As Integer
On Error Resume Next
If A2000.ActiveDocument.SelectionSets.Count <> 0 Then
  For i = 0 To A2000.ActiveDocument.slelctionset.Count - 1
    Set SSET = A2000.ActiveDocument.SelectionSets(i)
    SSET.Delete
  Next i
End If

Set SSET = A2000.ActiveDocument.SelectionSets.Add("AAA")

Dim STR1 As String
STR1 = InputBox("请输入需要查询标高的桩号", "根据桩号查询标高")

AppActivate AutoCAD.Application.Caption
SSET.SelectOnScreen
AppActivate Form1.Caption

Dim ENT1 As AcadEntity, ENT2 As AcadLine
Dim SP(0 To 2) As Double, EP(0 To 2) As Double
Dim N As Integer

SP(0) = CDbl(STR1): SP(1) = 0: SP(2) = 0
EP(0) = CDbl(STR1): EP(1) = 10: EP(2) = 0
Set ENT2 = A2000.ActiveDocument.ModelSpace.AddLine(SP, EP)

Set ENT1 = SSET.Item(0)

Dim IntPoints As Variant
IntPoints = ENT1.IntersectWith(ENT2, acExtendOtherEntity)

If VarType(IntPoints) <> vbEmpty Then
  For N = LBound(IntPoints) To UBound(IntPoints) Step 3
    STR1 = STR1 & vbCrLf & "桩号" & STR1 & "的高程为:" & IntPoints(N + 1)
  Next N
'Else
'STR1 = "图元没有交点"
End If
MsgBox STR1
ENT2.Delete
End Sub

Private Sub Command2_Click()
Dim i As Integer
On Error Resume Next
If A2000.ActiveDocument.SelectionSets.Count <> 0 Then
  For i = 0 To A2000.ActiveDocument.slelctionset.Count - 1
    Set SSET = A2000.ActiveDocument.SelectionSets(i)
    SSET.Delete
  Next i
End If

Set SSET = A2000.ActiveDocument.SelectionSets.Add("AAA")

Dim STR1 As String, STR2 As String
STR1 = InputBox("请输入需要查询桩号的标高", "根据标高查询桩号")

AppActivate Application.Caption
SSET.SelectOnScreen
AppActivate Form1.Caption

Dim ENT1 As AcadEntity, ENT2 As AcadLine
Dim SP(0 To 2) As Double, EP(0 To 2) As Double
Dim N As Integer

SP(0) = 0: SP(1) = CDbl(STR1): SP(2) = 0
EP(0) = 10: EP(1) = CDbl(STR1): EP(2) = 0
Set ENT2 = A2000.ActiveDocument.ModelSpace.AddLine(SP, EP)

Set ENT1 = SSET.Item(0)

Dim IntPoints As Variant
IntPoints = ENT1.IntersectWith(ENT2, acExtendOtherEntity)

If VarType(IntPoints) <> vbEmpty Then
  For N = LBound(IntPoints) To UBound(IntPoints) Step 3
    STR2 = STR2 & vbCrLf & "高程" & STR1 & "的桩号为:" & CStr(IntPoints(N))
  Next N
'Else
'STR1 = "图元没有交点"
End If
MsgBox STR2
ENT2.Delete
End Sub

Private Sub Command3_Click()
Set A2000 = Nothing
Set SSET = Nothing
Unload Me
End Sub

Private Sub Form_Load()
Set A2000 = GetObject(, "AutoCAD.Application")
End Sub

南子

1、您测试时用了ON ERROR RESUME NEXT，他使您跳过了问题，没有发现.
2、If A2000.ActiveDocument.SelectionSets.Count <> 0 Then
  For i = 0 To A2000.ActiveDocument.slelctionset.Count - 1
    Set SSET = A2000.ActiveDocument.SelectionSets(i)
    SSET.Delete
  Next i
End If
  slelctionset应为SELECTIONSETS
3、A2000.ActiveDocument.slelctionset.Count - 1应该加括号

以下代码已经测试成功，包括编译成EXE文件
：Option Explicit
Dim A2000 As AcadApplication
Dim SSET As AcadSelectionSet
Private Sub Command1_Click()
Dim i As Integer
If A2000.ActiveDocument.SelectionSets.Count <> 0 Then
  For i = 0 To (A2000.ActiveDocument.SelectionSets.Count - 1)
    Set SSET = A2000.ActiveDocument.SelectionSets(i)
    SSET.Delete
  Next i
End If

Set SSET = A2000.ActiveDocument.SelectionSets.Add("AAA")
AppActivate AutoCAD.Application.Caption
SSET.SelectOnScreen
AppActivate Form1.Caption
MsgBox "selectonscreen ok!"
End Sub
Private Sub Form_Load()
Set A2000 = GetObject(, "AutoCAD.Application")
End Sub