我想通过四点坐标建立选择集 为什么总是提示 模式或点列表错误啊 ?- 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
|