|
|
大家好！最近编的程序含选择集的部分如下所示。有两个问题请教高人：
（1）调试过程是用一个正方形和4个孤立点的。case 1的调试过程中，设置了Sset.count为参数，发现一直为0，不知道哪里出错？
（2）case 2运行中，jh_dian.count正常，大方向没问题。但粗线部分该怎么写啊？就是说令Shy=该图元的类型该用何语句？
在此先多谢各位不吝指教了！
Dim Sset As AcadSelectionSet
Dim insPoint As Variant
Dim KeyWord As String
On Error Resume Next
Set Sset = ThisDrawing.SelectionSets.Add("mky")
If Err Then
Err.Clear
Set Sset = ThisDrawing.SelectionSets.Item("mky")
Sset.Clear
End If
'新建空选择集
ThisDrawing.Utility.InitializeUserInput 0, "1 2"
KeyWord = ThisDrawing.Utility.GetKeyword(vbCrLf & "选择选点方式1)在屏幕上直接指点；(2)一次性框选点 ")
If KeyWord = "" Then KeyWord = "1"
Select Case KeyWord
Case "1"
Do
insPoint = ThisDrawing.Utility.GetPoint(, "请在屏幕上指定点(右键退出):")
If Not (Err.Number = 13 Or Err.Number = -2145320928) Then
Sset.Add insPoint
End If
Loop Until Err.Number = 13 Or Err.Number = -2145320928
Err.Clear
Case "2"
Dim PointOBj As AcadBlockReference
Dim Point As AcadPoint
Dim TemPnt(0 To 1) As Double
Dim jh_dian As AcadSelectionSet
Call Addselection(jh_dian, "JH_Dian")
Dim FilterType(6) As Integer
Dim FilterData(6) As Variant
Dim layername As String
layername = ThisDrawing.ActiveLayer.Name
FilterType(0) = -4
FilterData(0) = ""
FilterType(5) = 8
FilterData(5) = layername
FilterType(6) = -4
FilterData(6) = "and>"
ThisDrawing.Utility.Prompt vbCrLf + "请从屏幕上选取点！" + vbCrLf
jh_dian.SelectOnScreen FilterType, FilterData
Dim Sty As String
Dim i As Long
For i = 0 To (jh_dian.Count - 1)
Sty = jh_dian.Item(i).HasExtensionDictionary
If Sty = "Point" Then
Set Point = jh_dian.Item(i)
TemPnt(0) = Point.Coordinates(0)
TemPnt(1) = Point.Coordinates(1)
Else
Set PointOBj = jh_dian.Item(i)
TemPnt(0) = PointOBj.InsertionPoint(0)
TemPnt(1) = PointOBj.InsertionPoint(1)
End If
Sset.Add TemPnt
Next
jh_dian.Delete
End Select
If Sset.Count = 0 Then
Sset.Delete
MsgBox "已选取 0 个点，不能生成表格。", vbExclamation
Exit Sub
End If
ThisDrawing.Utility.Prompt vbCrLf + "命令:你在屏上选定了" & Sset.Count & "个坐标点 " + vbCrLf
|
|
置顶卡
