Mekanikles
Mechanical
- Jan 21, 2014
- 20
Hi,
Maybe we can solve this together.. The idea is to make two circles to extrude along any polyline given. I'm extruding one circle at a time. But at the moment I'm stuck while trying to get the coordinates from my polyline. I get a type '13' mismatch on "polycoords". What am I missing?
Here is the code so far for one circle:
Private Sub CommandButton1_Click()
UserForm1.Hide
Dim D1 As Double
Dim t1 As Double
Dim r1 As Double
Dim circlecenter(0 To 2) As Double
Dim Circle1, Circle2 As AcadCircle
Dim Region As Variant
'Dim objSolidPol As Object
Dim oEnt As AcadEntity
Dim varpt As Variant
Dim pts As Variant
'Dim rotpoint1(2) As Double
'Dim rotpoint2(2) As Double
Dim Sweep1 As Acad3DSolid
Dim PolyCoords As Variant
D1 = Val(TextBox1.Text)
t1 = Val(TextBox2.Text)
r1 = D1 / 2
ThisDrawing.Utility.GetEntity oEnt, varpt, vbCr & "Select polyline"
If Not TypeOf oEnt Is AcadLWPolyline And _
Not TypeOf oEnt Is Acad3DPolyline And _
Not TypeOf oEnt Is AcadPolyline Then
MsgBox "Method is not applicable for this entity type"
Exit Sub
End If
pts = PolyCoords(oEnt) ' Here is the mismatch
circlecenter(0) = 0: circlecenter(1) = 0: circlecenter(2) = 0
Set Circle1 = ThisDrawing.ModelSpace.AddCircle(circlecenter, r1)
Region = ThisDrawing.ModelSpace.AddRegion(Circle1)
Set Sweep1 = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(Region, pts)
End Sub
Thanks in advance!
"If you're not part of the solution, you're part of the problem" - John McClane,Die hard
Maybe we can solve this together.. The idea is to make two circles to extrude along any polyline given. I'm extruding one circle at a time. But at the moment I'm stuck while trying to get the coordinates from my polyline. I get a type '13' mismatch on "polycoords". What am I missing?
Here is the code so far for one circle:
Private Sub CommandButton1_Click()
UserForm1.Hide
Dim D1 As Double
Dim t1 As Double
Dim r1 As Double
Dim circlecenter(0 To 2) As Double
Dim Circle1, Circle2 As AcadCircle
Dim Region As Variant
'Dim objSolidPol As Object
Dim oEnt As AcadEntity
Dim varpt As Variant
Dim pts As Variant
'Dim rotpoint1(2) As Double
'Dim rotpoint2(2) As Double
Dim Sweep1 As Acad3DSolid
Dim PolyCoords As Variant
D1 = Val(TextBox1.Text)
t1 = Val(TextBox2.Text)
r1 = D1 / 2
ThisDrawing.Utility.GetEntity oEnt, varpt, vbCr & "Select polyline"
If Not TypeOf oEnt Is AcadLWPolyline And _
Not TypeOf oEnt Is Acad3DPolyline And _
Not TypeOf oEnt Is AcadPolyline Then
MsgBox "Method is not applicable for this entity type"
Exit Sub
End If
pts = PolyCoords(oEnt) ' Here is the mismatch
circlecenter(0) = 0: circlecenter(1) = 0: circlecenter(2) = 0
Set Circle1 = ThisDrawing.ModelSpace.AddCircle(circlecenter, r1)
Region = ThisDrawing.ModelSpace.AddRegion(Circle1)
Set Sweep1 = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(Region, pts)
End Sub
Thanks in advance!
"If you're not part of the solution, you're part of the problem" - John McClane,Die hard