I am trying to use some code that I think Bryco helped me with years ago to extrude a circle along a spline path. I cannot figure out why this doesn't work
Public Sub DrawCable()
On Error GoTo err_control
' Dim InsPt As Variant, dblRot As Double, strPrompt As String, intBusCenterLine As Integer
Dim dblBusDia As Double
Dim oLayer As AcadLayer, oLine As AcadSpline, objPath As Object
Dim newPT1(2) As Double
Dim newPT2(2) As Double
Dim P1, P2
Dim V(2) As Double, Unit As Double, Vn(2) As Double
Dim oCyl As Acad3DSolid, oCircle As AcadCircle
Dim regent(0) As AcadEntity
Dim oReg As Variant
Start:
dblBusDia = 1.45
Set oLayer = ThisDrawing.Layers.Add("3D-BUSS-CALC")
oLayer.color = 234
Dim objSelected As Object
Dim objSelSet As AcadSelectionSet
Set oLayer = ThisDrawing.Layers.Add("3D-BUSS")
oLayer.color = 3
Set objSelSet = ThisDrawing.SelectionSets.Add("Bus")
objSelSet.SelectOnScreen
For Each objSelected In objSelSet
If Not TypeOf objSelected Is AcadSpline Then
MsgBox "That was not a Layout Line"
Exit Sub
End If
Set oLine = objSelected
Set objPath = objSelected
newPT1(0) = oLine.FitPoints(0): newPT1(1) = oLine.FitPoints(1): newPT1(2) = oLine.FitPoints(2)
newPT2(0) = oLine.FitPoints(3): newPT2(1) = oLine.FitPoints(4): newPT2(2) = oLine.FitPoints(5)
P1 = newPT1
P2 = newPT2
V(0) = P2(0) - P1(0): V(1) = P2(1) - P1(1): V(2) = P2(2) - P1(2)
'Normalise the vector(It's length=1)
Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
Set oCircle = ThisDrawing.ModelSpace.AddCircle(P1, dblBusDia / 2)
oCircle.Normal = Vn ' Vn or V both work here.
Set regent = oCircle
oReg = ThisDrawing.ModelSpace.AddRegion(regent)
Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(oReg(0), objPath)
oCyl.Layer = "3D-BUSS"
oCircle.Delete
oReg(0).Delete
Next
ThisDrawing.SelectionSets.Item("Bus").Delete
ThisDrawing.Application.Update
Exit_Here:
ThisDrawing.SetVariable "INSUNITS", 1
Unload frmBus
Exit Sub
err_control:
Select Case Err.Number
Case "-2145320851"
ThisDrawing.SelectionSets.Item("Bus").Delete
Err.Clear
Resume
Case Else
MsgBox Err.Description
oCircle.Delete
oReg(0).Delete
Resume Exit_Here
End Select
End Sub