Public Sub DrawBus()
On Error GoTo err_control
Dim InsPt As Variant, dblRot As Double, strPrompt As String, intBusCenterLine As Integer
Dim strDrawing As String, dblBusDia As Double
Dim oLayer As AcadLayer, oLine As AcadLine
Dim newPT1 As Variant
Dim newPT2 As Variant
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
Start:
IsSetup
frmBus.Show
If frmBus.optHighBus.Value = True Then
intBusCenterLine = RegistryEdit.getRegVal(HighBus)
Else
intBusCenterLine = RegistryEdit.getRegVal(LowBus)
End If
Select Case (getRegVal(BusSize))
Case "30"
dblBusDia = (3# / 2) + 0.25
Case "35"
dblBusDia = (3.5 / 2) + 0.25
Case "40"
dblBusDia = (4# / 2) + 0.25
Case "50"
dblBusDia = (5# / 2) + 0.25
End Select
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 AcadLine Then
MsgBox "That was not a Layout Line"
Exit Sub
End If
Set oLine = objSelected
newPT1 = oLine.StartPoint
newPT2 = oLine.EndPoint
newPT1(2) = intBusCenterLine
newPT2(2) = intBusCenterLine
Set oLine = ThisDrawing.ModelSpace.AddLine(newPT1, newPT2)
oLine.Layer = "3D-BUSS-CALC"
P1 = oLine.StartPoint: P2 = oLine.EndPoint
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(oLine.StartPoint, dblBusDia)
oCircle.Normal = Vn ' Vn or V both work here.
Set regent(0) = oCircle
oReg = ThisDrawing.ModelSpace.AddRegion(regent)
Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolid(oReg(0), oLine.Length, 0)
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
Resume Exit_Here
End Select
End Sub
(defun c:test ( / enx hgt ins mat obj rad sel vec )
(setq rad 2.5 ;; Cylinder Radius
hgt 5.0 ;; Cylinder Height
)
(if (setq sel (ssget "_+.:E:S" '((0 . "LINE") (410 . "Model"))))
(progn
(setq enx (entget (ssname sel 0))
ins (cdr (assoc 10 enx))
vec (mapcar '- (cdr (assoc 11 enx)) ins)
obj (vla-addcylinder (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3D-point ins) rad hgt)
mat (mapcar '(lambda ( v ) (trans v 0 vec t)) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)))
)
(vla-transformby obj
(vlax-tmatrix
(append
(mapcar 'append mat
(mapcar 'list
(mapcar '+ (trans (list 0.0 0.0 (/ hgt 2.0)) vec 0 t)
(mapcar '- ins (mxv mat ins))
)
)
)
'((0.0 0.0 0.0 1.0))
)
)
)
)
)
(princ)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(vl-load-com) (princ)
(defun c:test ( / enx hgt ins mat obj rad sel vec )
(setq rad 2.5 ;; Cylinder Radius
hgt 5.0 ;; Cylinder Height
)
;; Retrieve single selection of LINE entity
(if (setq sel (ssget "_+.:E:S" '((0 . "LINE") (410 . "Model"))))
(progn
(setq
;; DXF data of selected Line
enx (entget (ssname sel 0))
;; Start point of Line (insertion point for Cylinder)
ins (cdr (assoc 10 enx))
;; Line vector
vec (mapcar '- (cdr (assoc 11 enx)) ins)
;; VLA Cylinder Object with insertion point at start point of line and radius and height as specified above.
;; Note: at this point, the cylinder has extrusion vector 0,0,1 and the insertion point is at the midpoint.
obj (vla-addcylinder (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3D-point ins) rad hgt)
;; Change of basis matrix to transform to coordinate system defined by the
;; line vector under the Arbitrary Axis Algorithm.
mat (mapcar '(lambda ( v ) (trans v 0 vec t)) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)))
)
;; Transform the Cylinder by the following transformation matrix
(vla-transformby obj
;; Convert the following 4x4 list to a transformation matrix variant
(vlax-tmatrix
;; Append the last row to the 3x4 matrix
(append
;; Append the translation vector to the 3x3 change of basis matrix
(mapcar 'append mat
;; Convert the translation vector to a list of lists for appending
(mapcar 'list
;; Include a translation by half the cylinder height in the Z-direction
;; to ensure the Line start point is at the cylinder base
(mapcar '+ (trans (list 0.0 0.0 (/ hgt 2.0)) vec 0 t)
;; Calculate the translation vector to retain the cylinder position
;; following application of the change of basis matrix
(mapcar '- ins (mxv mat ins))
)
)
)
;; The last row of the transformation matrix to obtain a square 4x4 matrix
'((0.0 0.0 0.0 1.0))
)
)
)
)
)
(princ)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(vl-load-com) (princ)
so enx is the line
ins is the startpoint of line
vec is the vector of line gotten by subtracting endpoint from startpoint?
obj is the new cylinder
mat is the trans matrix?
Which makes the normal 1 unit long in the direction of the vector?