VBA 2015

Anonymous — Mon, 05 Jan 2015 00:45:56 GMT

Why won't this work in 2015 compared to 2014?

Option Explicit
Dim DblDiameter As Double
Dim varPnt1 As Variant
Dim varPnt2 As Variant
Dim dblHeight As Double
Dim varPnt1UCS As Variant

Public Sub Bolts()

DblDiameter = ThisDrawing.Utility.GetInteger("Input bolt diameter: ")
varPnt1 = ThisDrawing.Utility.GetPoint(, "Pick bolt head side")
varPnt1UCS = ThisDrawing.Utility.TranslateCoordinates(varPnt1, acWorld, acUCS, False)
varPnt2 = ThisDrawing.Utility.GetPoint(varPnt1UCS, "Pick nut side")

dblHeight = Distance(varPnt1, varPnt2)

SolidBolt
SolidNut

End Sub

Function Add_UCS_improved(origin() As Double, xAxisPnt() _
As Double, yAxisPnt() As Double, ucsName As String) As AcadUCS
' origin, xAxisPnt, and yAxisPnt must all be dimmed (0 to 2)

Dim ucsObj As AcadUCS
Dim xAxisVec(0 To 2) As Double
Dim yAxisVec(0 To 2) As Double
Dim perpYaxisPnt(0 To 2) As Double
Dim xCy As Variant, perpYaxisVec As Variant

Debug.Print "xAxisPnt: " & xAxisPnt(0) & ", " & xAxisPnt(1) & ", " & xAxisPnt(2)
Debug.Print "yAxisPnt: " & yAxisPnt(0) & ", " & yAxisPnt(1) & ", " & yAxisPnt(2)
Debug.Print "origin: " & origin(0) & ", " & origin(1) & ", " & origin(2)

xAxisVec(0) = xAxisPnt(0) - origin(0)
xAxisVec(1) = xAxisPnt(1) - origin(1)
xAxisVec(2) = xAxisPnt(2) - origin(2)
yAxisVec(0) = yAxisPnt(0) - origin(0)
yAxisVec(1) = yAxisPnt(1) - origin(1)
yAxisVec(2) = yAxisPnt(2) - origin(2)

Debug.Print "xAxis: " & xAxisVec(0) & ", " & xAxisVec(1) & ", " & xAxisVec(2)
Debug.Print "yAxis: " & yAxisVec(0) & ", " & yAxisVec(1) & ", " & yAxisVec(2)

xCy = Cross3D(xAxisVec, yAxisVec)

Debug.Print "xCy: " & xCy(0) & ", " & xCy(1) & ", " & xCy(2)

perpYaxisVec = Cross3D(xCy, xAxisVec)

Debug.Print "perpYaxisVec: " & perpYaxisVec(0) & ", " & perpYaxisVec(1) & ", " & perpYaxisVec(2)

perpYaxisPnt(0) = perpYaxisVec(0) + origin(0)
perpYaxisPnt(1) = perpYaxisVec(1) + origin(1)
perpYaxisPnt(2) = perpYaxisVec(2) + origin(2)

Debug.Print "perpYaxisPnt: " & perpYaxisPnt(0) & ", " & perpYaxisPnt(1) & ", " & perpYaxisPnt(2)

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, perpYaxisPnt, ucsName)
Set Add_UCS_improved = ucsObj

End Function

Function Cross3D(A As Variant, B As Variant) As Variant
' A and B must be dimensioned Double(0 to 2)
Dim C(0 To 2) As Double
C(0) = A(1) * B(2) - A(2) * B(1)
C(1) = -(A(0) * B(2) - A(2) * B(0))
C(2) = A(0) * B(1) - A(1) * B(0)
Cross3D = C
End Function

Function Distance(p1, p2) As Variant

Dim xDist As Variant
Dim yDist As Variant
Dim zDist As Variant

xDist = p1(0) - p2(0)
yDist = p1(1) - p2(1)
zDist = p1(2) - p2(2)

Distance = Sqr(xDist ^ 2 + yDist ^ 2 + zDist ^ 2)

End Function

Public Function RoundToValue(ByVal nValue, _
nCeiling As Double, Optional RoundUp As Boolean = True) _
As Double

Dim tmp As Integer
Dim tmpVal
If Not IsNumeric(nValue) Then Exit Function
nValue = CDbl(nValue)

'Round up to a whole integer -
'Any decimal value will force a round to the next integer.
'i.e. 0.01 = 1 or 0.8 = 1

tmpVal = ((nValue / nCeiling) + (-0.5 + (RoundUp And 1)))
tmp = Fix(tmpVal)
tmpVal = CInt((tmpVal - tmp) * 10 ^ 0)
nValue = tmp + tmpVal / 10 ^ 0

'Multiply by ceiling value to set RoundtoValue
RoundToValue = nValue * nCeiling

End Function

Function SolCylinder(diameter As Double, Height As Double)

'This function creates a 3D cylinder based on supplied data. Centre is the point at the start
'of the cylinder. Diameter is self explanatory. Height is the length of the cylinder
'A negative value acts the same as the extrude command.

Dim dblRadius As Double
Dim dblCenter(2) As Double

dblRadius = diameter / 2

'' calculate center point from input
dblCenter(0) = 0
dblCenter(1) = 0
dblCenter(2) = (Height / 2)

If Height < 0 Then
Height = -Height
End If

Set SolCylinder = ThisDrawing.ModelSpace.AddCylinder(dblCenter, dblRadius, Height)

End Function

Function RotateAngle(Point1 As Variant, Point2 As Variant)

Dim yAxisPnt(2) As Double
Dim xAxisPnt(2) As Double
Dim origin(2) As Double
Dim testUCS As AcadUCS
Dim dblAngle As Double
Dim dbla As Double
Dim dblb As Double
Dim dblc As Double

yAxisPnt(0) = Point1(0)
yAxisPnt(1) = Point1(1)
yAxisPnt(2) = Point1(2) + Distance(Point1, Point2)

origin(0) = Point1(0)
origin(1) = Point1(1)
origin(2) = Point1(2)

xAxisPnt(0) = Point2(0)
xAxisPnt(1) = Point2(1)
xAxisPnt(2) = Point2(2)

If Point1(0) = Point2(0) And Point1(1) = Point2(1) Then
RotateAngle = 0
Else

Set testUCS = Add_UCS_improved(origin, xAxisPnt, yAxisPnt, "test")

ThisDrawing.ActiveUCS = testUCS

dbla = Distance(origin, xAxisPnt)
dblb = dbla
dblc = Distance(yAxisPnt, xAxisPnt)

dblAngle = ((dbla ^ 2 + dblb ^ 2 - dblc ^ 2) / (2 * dbla * dblb))
dblAngle = Atn(-dblAngle / Sqr(-dblAngle * dblAngle + 1)) + 2 * Atn(1)

RotateAngle = -dblAngle
End If

End Function

Private Sub SolidBolt()

' Define the UCS pointsCyl
Dim xAxisPnt(0 To 2) As Double
xAxisPnt(0) = 1: xAxisPnt(1) = 0: xAxisPnt(2) = 0

Dim yAxisPnt(0 To 2) As Double
yAxisPnt(0) = 0: yAxisPnt(1) = 1: yAxisPnt(2) = 0

Dim zAxisPnt(0 To 2) As Double
zAxisPnt(0) = 0: zAxisPnt(1) = 0: zAxisPnt(2) = 1

Dim origin(2) As Double
origin(0) = 0#: origin(1) = 0#: origin(2) = 0#

' Add the UCS to the
' UserCoordinatesSystems collection
Dim ucsObj As AcadUCS
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, zAxisPnt, "New_UCS")

' Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj

Dim pointsCyl(0 To 9) As Double
Dim diameter As Double
Dim pi

pi = 4 * Atn(1)
diameter = DblDiameter

' Define the 2D polyline pointsCyl
pointsCyl(0) = 0: pointsCyl(1) = 0
pointsCyl(2) = ((0.8 * diameter) / Cos(30 * (pi / 180))): pointsCyl(3) = 0
pointsCyl(4) = ((0.8 * diameter) / Cos(30 * (pi / 180))): pointsCyl(5) = -((0.7 * diameter) - ((diameter / Cos(30 * (pi / 180))) - diameter))
pointsCyl(6) = 0.8 * diameter: pointsCyl(7) = -(0.7 * diameter)
pointsCyl(8) = 0: pointsCyl(9) = -(0.7 * diameter)

With ThisDrawing.ModelSpace

Dim PlineCyl As AcadLWPolyline
' Create a lightweight Polyline object in model space
Set PlineCyl = .AddLightWeightPolyline(pointsCyl)
PlineCyl.Closed = True

Dim RegionCyl(0) As Object
Set RegionCyl(0) = PlineCyl

Dim RegionC As Variant
RegionC = .AddRegion(RegionCyl)

Dim Axis(2) As Double
Axis(0) = 0#: Axis(1) = 0#: Axis(2) = 1#

Dim SolidCyl As Acad3DSolid
Set SolidCyl = .AddRevolvedSolid(RegionC(0), origin, Axis, 360)

End With

PlineCyl.Delete
RegionC(0).Delete

Dim dblLength As Double
dblLength = Distance(varPnt1, varPnt2)
dblLength = RoundToValue((dblLength + (0.2 * DblDiameter) + DblDiameter + 5), 5, True)

Dim pointsCha(0 To 5) As Double
pointsCha(0) = ((diameter / 2) - (0.075 * diameter)): pointsCha(1) = dblLength
pointsCha(2) = (diameter / 2): pointsCha(3) = dblLength
pointsCha(4) = (diameter / 2): pointsCha(5) = (dblLength - (0.075 * diameter))

With ThisDrawing.ModelSpace

Dim PlineCha As AcadLWPolyline
' Create a lightweight Polyline object in model space
Set PlineCha = .AddLightWeightPolyline(pointsCha)
PlineCha.Closed = True

Dim RegionCha(0) As Object
Set RegionCha(0) = PlineCha

Dim RegionCh As Variant
RegionCh = .AddRegion(RegionCha)

Dim SolidCha As Acad3DSolid
Set SolidCha = .AddRevolvedSolid(RegionCh(0), origin, Axis, 360)

End With

PlineCha.Delete
RegionCh(0).Delete

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")

' Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj

Dim pointsHex(0 To 11) As Double
pointsHex(0) = ((0.8 * diameter) / Cos(30 * (pi / 180))): pointsHex(1) = 0
pointsHex(2) = ((0.8 * diameter) * Tan(30 * (pi / 180))): pointsHex(3) = (0.8 * diameter)
pointsHex(4) = -((0.8 * diameter) * Tan(30 * (pi / 180))): pointsHex(5) = (0.8 * diameter)
pointsHex(6) = -((0.8 * diameter) / Cos(30 * (pi / 180))): pointsHex(7) = 0
pointsHex(8) = -((0.8 * diameter) * Tan(30 * (pi / 180))): pointsHex(9) = -(0.8 * diameter)
pointsHex(10) = ((0.8 * diameter) * Tan(30 * (pi / 180))): pointsHex(11) = -(0.8 * diameter)

With ThisDrawing.ModelSpace

Dim PlineHex As AcadLWPolyline
' Create a lightweight Polyline object in model space
Set PlineHex = .AddLightWeightPolyline(pointsHex)
PlineHex.Closed = True

Dim RegionHex(0) As Object
Set RegionHex(0) = PlineHex

Dim RegionH As Variant
RegionH = .AddRegion(RegionHex)

Dim SolidHex As Acad3DSolid
Set SolidHex = .AddExtrudedSolid(RegionH(0), -(0.7 * diameter), 0)

SolidCyl.Boolean acIntersection, SolidHex

Dim SolidShaft As Acad3DSolid
Set SolidShaft = SolCylinder(DblDiameter, dblLength)

SolidCyl.Boolean acUnion, SolidShaft
SolidCyl.Boolean acSubtraction, SolidCha
SolidCyl.Move origin, varPnt1
SolidCyl.Rotate varPnt1, RotateAngle(varPnt1, varPnt2)
SolidCyl.Update

Dim SolidWash1 As Acad3DSolid
Dim SolidWash2 As Acad3DSolid
Set SolidWash1 = SolCylinder((2 * DblDiameter), (0.2 * DblDiameter))
Set SolidWash2 = SolCylinder(DblDiameter, (0.2 * DblDiameter))
SolidWash1.Boolean acSubtraction, SolidWash2
SolidWash1.Move origin, varPnt1
SolidWash1.Rotate varPnt1, RotateAngle(varPnt1, varPnt2)
SolidWash1.Move varPnt1, varPnt2

SolidWash1.Update

PlineHex.Delete
RegionH(0).Delete

End With

End Sub

Private Sub SolidNut()

' Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj

Dim pointsCyl(0 To 11) As Double
Dim diameter As Double
Dim pi

pi = 4 * Atn(1)
diameter = DblDiameter

' Define the 2D polyline pointsCyl
pointsCyl(0) = diameter / 2: pointsCyl(1) = 0
pointsCyl(2) = 0.8 * diameter: pointsCyl(3) = 0
pointsCyl(4) = ((0.8 * diameter) / Cos(30 * (pi / 180))): pointsCyl(5) = -((diameter / Cos(30 * (pi / 180))) - diameter)
pointsCyl(6) = ((0.8 * diameter) / Cos(30 * (pi / 180))): pointsCyl(7) = -((0.8 * diameter) - ((diameter / Cos(30 * (pi / 180))) - diameter))
pointsCyl(8) = 0.8 * diameter: pointsCyl(9) = -(0.8 * diameter)
pointsCyl(10) = diameter / 2: pointsCyl(11) = -(0.8 * diameter)

Dim RegionHex(0) As Object
Set RegionHex(0) = PlineHex

Dim RegionH As Variant
RegionH = .AddRegion(RegionHex)

Dim SolidHex As Acad3DSolid
Set SolidHex = .AddExtrudedSolid(RegionH(0), -(0.8 * diameter), 0)

SolidCyl.Boolean acIntersection, SolidHex

Dim nutLen(0 To 2) As Double
nutLen(0) = 0: nutLen(1) = 0: nutLen(2) = (Distance(varPnt1, varPnt2) + diameter)

SolidCyl.Move origin, nutLen
SolidCyl.Move origin, varPnt1
SolidCyl.Rotate varPnt1, RotateAngle(varPnt1, varPnt2)
SolidCyl.Update

PlineHex.Delete
RegionH(0).Delete

End With

End Sub

Re: VBA 2015

owenwengerd — Mon, 05 Jan 2015 02:22:28 GMT

This is a technical forum, so you're much more likely to get help if you use precise terminology. Phrases like "won't work" are not helpful in diagnosing the problem. It would also be helpful if you trace the problem to a specific line of code. Ideally you should describe what steps you take, what you expect to happen, and what actually happens.

Re: VBA 2015

Anonymous — Mon, 05 Jan 2015 02:34:02 GMT

Thanks for the tip 🙂

It is suppose to draw a 3d model of a bolt with nut and washer (metric) after inputing diameter and picking 2 points.

Now all it draws is a cylinder for the bolt and a washer (refer to attached images)

How would I isolate a line of code.

Regards,

Simon

Re: VBA 2015

owenwengerd — Mon, 05 Jan 2015 19:04:10 GMT

You can use the VBAIDE command to open the IDE. There you can set a breakpoint in your function, switch to AutoCAD and execute it, then when the breakpoint is hit you can step through the code line by line to inspect variable values and watch for errors to see where it does something unexpected. It looks like the bolt head and nut are created near the end of the function.

topic Re: VBA 2015 in VBA Forum

VBA 2015

Re: VBA 2015

Re: VBA 2015

Re: VBA 2015