求助：关于SelectByPolygon
我想通过四点坐标建立选择集 为什么总是提示模式或点列表错误啊？Private Sub CommandButton1_Click()UserForm1.hide
Dim ssdmx As AcadSelectionSet, TDMX As Object, FTDMX(1) As Integer, FDDMX(1) As Variant
Dim ssgcd As AcadSelectionSet, Tgcd As Object, FTgcd(1) As Integer, FDgcd(1) As Variant
Dim Pxdmx1 As Double
Dim Pxdmx2 As Double
Dim Pydmx1 As Double
Dim Pydmx2 As Double
Dim V As Variant '断面线顶点坐标
Dim sin As Double
Dim cos As Double
Dim pfwx(12) As Double
Dim kx As Double
Dim ky As Double
' FTDMX(0) = 0: FDDMX(0) = "LWPOLYLINE"
Set ssdmx = ThisDrawing.SelectionSets.Add("ssdmx")
ssdmx.SelectOnScreen 'FTDMX, FDDMX
If ssdmx.Count > 0 Then
V = ssdmx.Item(ssdmx.Count - 1).Coordinates '提取二维多段线顶点坐标(二维)
For I = 0 To 1
If I = 0 Then
Pxdmx1 = V(I * 2)
Pydmx1 = V(I * 2 + 1)
End If
If I = 1 Then
Pxdmx2 = V(I * 2)
Pydmx2 = V(I * 2 + 1)
End If
Next I
End If
ssdmx.Delete
If Pxdmx1 - Pxdmx2 = 0 Then
If Pydmx1 > Pydmx2 Then
kx = Pxdmx1
ky = Pydmx1
Pydmx1 = Pydmx2
Pydmx2 = ky
Pxdmx1 = Pxdmx2
Pxdmx2 = kx
End If
pfwx(0) = Pxdmx1 + Val(TextBox1.Text): pfwx(1) = Pydmx1: pfwx(2) = 0
pfwx(3) = Pxdmx2 + Val(TextBox1.Text): pfwx(4) = Pydmx2: pfwx(5) = 0
pfwx(6) = Pxdmx2 - Val(TextBox1.Text): pfwx(7) = Pydmx2: pfwx(8) = 0
pfwx(9) = Pxdmx1 - Val(TextBox1.Text): pfwx(10) = Pydmx1: pfwx(11) = 0
End If
If (Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) = 0 Then
If Pxdmx1 > Pxdmx2 Then
kx = Pxdmx1
ky = Pydmx1
Pydmx1 = Pydmx2
Pydmx2 = ky
Pxdmx1 = Pxdmx2
Pxdmx2 = kx
End If
pfwx(0) = Pxdmx1: pfwx(1) = Pydmx1 - Val(TextBox1.Text): pfwx(2) = 0
pfwx(3) = Pxdmx2: pfwx(4) = Pydmx2 - Val(TextBox1.Text): pfwx(5) = 0
pfwx(6) = Pxdmx2: pfwx(7) = Pydmx2 + Val(TextBox1.Text): pfwx(8) = 0
pfwx(9) = Pxdmx1: pfwx(10) = Pydmx1 + Val(TextBox1.Text): pfwx(11) = 0
End If
If (Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) > 0 Then
If Pxdmx1 > Pxdmx2 Then
kx = Pxdmx1
ky = Pydmx1
Pydmx1 = Pydmx2
Pydmx2 = ky
Pxdmx1 = Pxdmx2
Pxdmx2 = kx
End If
cos = (Pydmx1 - (Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1) / (((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1 - Pydmx1) * (Pxdmx1 - Pxdmx2) / (Pydmx1 - Pydmx2))
sin = (((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1 - Pydmx1) * (Pxdmx1 - Pxdmx2) / (Pydmx1 - Pydmx2)) / (Pydmx1 - (Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1)
pfwx(0) = Pxdmx1 + Val(TextBox1.Text) * cos: pfwx(1) = Pydmx1 - Val(TextBox1.Text) * sin: pfwx(2) = 0
pfwx(3) = Pxdmx2 + Val(TextBox1.Text) * cos: pfwx(4) = Pydmx2 - Val(TextBox1.Text) * sin: pfwx(5) = 0
pfwx(6) = Pxdmx2 - Val(TextBox1.Text) * cos: pfwx(7) = Pydmx2 + Val(TextBox1.Text) * sin: pfwx(8) = 0
pfwx(9) = Pxdmx1 - Val(TextBox1.Text) * cos: pfwx(10) = Pydmx1 + Val(TextBox1.Text) * sin: pfwx(11) = 0
End If
If (Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) < 0 Then
If Pxdmx1 < Pxdmx2 Then
kx = Pxdmx1
ky = Pydmx1
Pydmx1 = Pydmx2
Pydmx2 = ky
Pxdmx1 = Pxdmx2
Pxdmx2 = kx
End If
sin = (Pydmx1 - ((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2)) * Pxdmx1) / (((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1 - Pydmx1) * (Pxdmx1 - Pxdmx2) / (Pydmx1 - Pydmx2))
cos = (((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2) * Pxdmx1 - Pydmx1) * (Pxdmx1 - Pxdmx2) / (Pydmx1 - Pydmx2)) / (Pydmx1 - ((Pydmx1 - Pydmx2) / (Pxdmx1 - Pxdmx2)) * Pxdmx1)
pfwx(0) = Pxdmx1 + Val(TextBox1.Text) * sin: pfwx(1) = Pydmx1 + Val(TextBox1.Text) * cos: pfwx(2) = 0
pfwx(3) = Pxdmx2 + Val(TextBox1.Text) * sin: pfwx(4) = Pydmx2 + Val(TextBox1.Text) * cos: pfwx(5) = 0
pfwx(6) = Pxdmx2 - Val(TextBox1.Text) * sin: pfwx(7) = Pydmx2 - Val(TextBox1.Text) * cos: pfwx(8) = 0
pfwx(9) = Pxdmx1 - Val(TextBox1.Text) * sin: pfwx(10) = Pydmx1 - Val(TextBox1.Text) * cos: pfwx(11) = 0
' pfwx(12) = Pxdmx1 + Val(TextBox1.Text) * sin: pfwx(13) = Pydmx1 + Val(TextBox1.Text) * cos: pfwx(14) = 0
End If
FTgcd(0) = 8: FDgcd(0) = "gcd"
Set ssgcd = ThisDrawing.SelectionSets.Add("gcd")
ssgcd.SelectByPolygon acSelectionSetWindowPolygon, pfwx, FTgcd, FDgcd
If ssgcd.Count > 0 Then
For Each Tgcd In gcd
I = I + 1
Tgcd.Delete
Next
End If
End sub
页:
[1]