The Autocad ActiveX and VBA Developer’s Guide, Work in Three Dimensional Space (chap 8 in the old print version), is available with 10 sample code programs here
also in your autocad installation as a CHM file, (very easy to work with)
ProgramFiles\Common Files\Autodesk Shared\acadauto.chm
these sample programs paste in to Visual Studio with a few but not too many problems. Below is a screenshot of the first one. On the left is the virgin code. On the right is the corrected version which runs as intended.
Visual Studio throws up 8 errors on paste. (see ThisDrawing discussion below)
Let and Set assignment is no longer supported. You simply delete them.
acRed and acBlue is not declared. Hovering over the word acRed, Visual Studio suggests the fix, add the namespace ACAD_COLOR
Variant is no longer a supported type: Use the Object type instead.
Changing Variant to Object does eliminate the error on that line, but creates errors where it is accessed. Arrays are an area where dot.net has fixed logical inconsistencies in VBA. Autocad declared a return value of variant because static arrays could not accept an assigment. Dynamic arrays could accept assignment, but that was not in the very first version of VBA, and apparently never made it into the Autocad ActiveX implementation. There is no longer a distinction in dot.net between dynamic and static arrays.
We know the point data for polylines is a Double, and we know the autocad Coordinates method will return a variable number of points, so lets declare the variable as we would a double type dynamic array.
Dim get2Dpts() as Double
now we get an error on assigment –
get2Dpts = pline2DObj.Coordinates
Option Strict On disallows implicit conversions from ‘Object’ to ‘Double’.
anytime you get that and you know your variables are convertible the solution is Ctype(var, type)
get2Dpts = CType(pline2DObj.Coordinates, Double())
Autocad VBA sample code references a variable called ThisDrawing which is always available in the VBA environment. From Visual Studio, I run a sub called Connect_Acad that makes the connection and uses a global AcadDocument variable which can be named ThisDrawing and that is what i have done here. It is added to the top of the sample code.
Make those changes and it runs as is.
There is a simplification on the array assignments available in Visual Studio. In VBA I made subroutines to try to make the awkward point data assigments flow easier. VB.Net has a good new array feature called an initialization list.
you can change all this –
Dim points2D(0 To 5) As Double
Dim points3D(0 To 8) As Double
‘ Define three 2D polyline points
points2D(0) = 1 : points2D(1) = 1
points2D(2) = 1 : points2D(3) = 2
points2D(4) = 2 : points2D(5) = 2
‘ Define three 3D polyline points
points3D(0) = 1 : points3D(1) = 1 : points3D(2) = 0
points3D(3) = 2 : points3D(4) = 1 : points3D(5) = 0
points3D(6) = 2 : points3D(7) = 2 : points3D(8) = 0
to this –
‘ Define three 2D polyline points
Dim points2D() As Double = {1, 1, 1, 2, 2, 2}
‘ Define three 3D polyline points
Dim points3D() As Double = {1, 1, 0, 2, 1, 0, 2, 2, 0}
side by side screenshots –
*******************
NewUCS
*******************
9 errors on paste
Set
Method arguments must be enclosed in parentheses.
acWorld and acUCS is not declared.
fix those and down to 4 all due to Variant.
Dim WCSPnt As Variant
Dim UCSPnt As Variant
Lets try that again where we change the variant array to its target double array.
Dim WCSPnt() As Double
Dim UCSPnt() As Double
Again we get an error where Autocad Utility Getpoint is returning an Object, originally it was a Variant. We know its a double array so we can use the Ctype function.
The other and last error though is on the boolean argument in Utility.TranslateCoordinates.
UCSPnt = ThisDrawing.Utility.TranslateCoordinates(WCSPnt, AcCoordinateSystem.acWorld, AcCoordinateSystem.acUCS, False)
Strict On disallows implicit conversions from ‘Boolean’ to ‘Integer’.
That makes me want to look at the ActiveX Reference Guide under Objects Utility TranslateCoordinates. Its a flag possible values are True or False but its a Long type not Boolean. it affects whether the first argument is treated as an absolute point value or a vector. i dont quite know why its implemented like that but i can go with the value zero to get the intent.
That allows another error which has been in the queue on the same line. which is fixed by the familiar Ctype function.
And now it runs.
Arrays in VB.Net are all normally zero-based (with some exceptions). So VBA declarations such as Dim pt (0 to 2) as double can be changed to Dim pt(2) as Double. But we can also use the initialization list to clean up.
change this –
Dim origin(0 To 2) As Double
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double
origin(0) = 4 : origin(1) = 5 : origin(2) = 3
xAxisPnt(0) = 5 : xAxisPnt(1) = 5 : xAxisPnt(2) = 3
yAxisPnt(0) = 4 : yAxisPnt(1) = 6 : yAxisPnt(2) = 3
to this –
Dim origin() As Double = {4, 5, 3}
Dim xAxisPnt() As Double = {5, 5, 3}
Dim yAxisPnt() As Double = {4, 6, 3}
Sub Ch8_NewUCS()
Call Connect_acad()
Dim ucsObj As AcadUCS
Dim origin() As Double = {4, 5, 3}
Dim xAxisPnt() As Double = {5, 5, 3}
Dim yAxisPnt() As Double = {4, 6, 3}
' Add the UCS to the UserCoordinatesSystems collection
ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
' Display the UCS icon
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
ThisDrawing.ActiveViewport.UCSIconOn = True
' Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj
MsgBox("The current UCS is : " & ThisDrawing.ActiveUCS.Name & vbCrLf & " Pick a point in the drawing.")
' Find the WCS and UCS coordinate of a point
Dim WCSPnt() As Double
Dim UCSPnt() As Double
WCSPnt = CType(ThisDrawing.Utility.GetPoint(, "Enter a point: "), Double())
UCSPnt = CType(ThisDrawing.Utility.TranslateCoordinates(WCSPnt, AcCoordinateSystem.acWorld, AcCoordinateSystem.acUCS, 0), Double())
MsgBox("The WCS coordinates are: " & WCSPnt(0) & ", " & WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf &
"The UCS coordinates are: " & UCSPnt(0) & ", " & UCSPnt(1) & ", " & UCSPnt(2))
End Sub
*******************
TranslateCoordinates
*******************
8 errors on paste
Set, Arguments not enclosed in parentheses, unfound enumerations that need namespaces, and use of Variant arrays.
Dim firstVertex As Variant
firstVertex = plineObj.Coordinate(0)
looking up Polyline Object in the ActiveX Rerference Guide then clicking on Coordinate says the property value is a two or three element array of doubles.
change to –
Dim firstVertex() As Double
firstVertex = CType(plineObj.Coordinate(0), Double())
and
Dim coordinateWCS As Variant
coordinateWCS = ThisDrawing.Utility.TranslateCoordinates(firstVertex, AcCoordinateSystem.acOCS, AcCoordinateSystem.acWorld, False, plineNormal)
change to –
Dim coordinateWCS() As Double
coordinateWCS = CType(ThisDrawing.Utility.TranslateCoordinates(firstVertex, AcCoordinateSystem.acOCS, AcCoordinateSystem.acWorld, 0, plineNormal), Double())
Sub Ch8_TranslateCoordinates()
Call Connect_acad()
Dim plineObj As AcadPolyline
Dim points() As Double = {1, 1, 0, 1, 2, 0, 2, 2, 0, 3, 2, 0, 4, 4, 0}
' Create a light weight Polyline object in model space
plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
' Find the X and Y coordinates of the first vertex of the polyline
Dim firstVertex() As Double
firstVertex = CType(plineObj.Coordinate(0), Double())
' Find the Z coordinate for the polyline using the elevation property
firstVertex(2) = plineObj.Elevation
' Change the normal for the pline so that the difference between the coordinate systems is obvious.
Dim plineNormal() As Double = {0#, 1.0#, 2.0#}
plineObj.Normal = plineNormal
Dim coordinateWCS() As Double
coordinateWCS = CType(ThisDrawing.Utility.TranslateCoordinates(firstVertex, AcCoordinateSystem.acOCS, AcCoordinateSystem.acWorld, 0, plineNormal), Double())
' Display the coordinates of the point
MsgBox("The first vertex has the following coordinates:" & vbCrLf & "OCS: " & firstVertex(0) & ", " &
firstVertex(1) & ", " & firstVertex(2) & vbCrLf & "WCS: " & coordinateWCS(0) & ", " & coordinateWCS(1) & ", " & coordinateWCS(2))
End Sub
*************
Create3DMesh
************
here is one we can clean up quite a bit. it pastes in with only two errors, both trivial. It runs just by deleting the word Set, adding AcadApp. in front of ZoomAll and adding Connect_acad as the first line .
Here is the original VBA from Autocad.
Sub Ch8_Create3DMesh()
Dim meshObj As AcadPolygonMesh
Dim mSize, nSize, Count As Integer
Dim points(0 To 47) As Double
' create the matrix of points
points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 2: points(4) = 0: points(5) = 1
points(6) = 4: points(7) = 0: points(8) = 0
points(9) = 6: points(10) = 0: points(11) = 1
points(12) = 0: points(13) = 2: points(14) = 0
points(15) = 2: points(16) = 2: points(17) = 1
points(18) = 4: points(19) = 2: points(20) = 0
points(21) = 6: points(22) = 2: points(23) = 1
points(24) = 0: points(25) = 4: points(26) = 0
points(27) = 2: points(28) = 4: points(29) = 1
points(30) = 4: points(31) = 4: points(32) = 0
points(33) = 6: points(34) = 4: points(35) = 0
points(36) = 0: points(37) = 6: points(38) = 0
points(39) = 2: points(40) = 6: points(41) = 1
points(42) = 4: points(43) = 6: points(44) = 0
points(45) = 6: points(46) = 6: points(47) = 0
mSize = 4: nSize = 4
' creates a 3Dmesh in model space
Set meshObj = ThisDrawing.ModelSpace. _
Add3DMesh(mSize, nSize, points)
' Change the viewing direction of the viewport
' to better see the cylinder
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1
NewDirection(1) = -1
NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
code that runs in visual studio
Sub Ch8_Create3DMesh()
Call Connect_acad()
Dim meshObj As AcadPolygonMesh
Dim mSize, nSize, Count As Integer
Dim points() As Double =
{0, 0, 0,
2, 0, 1,
4, 0, 0,
6, 0, 1,
0, 2, 0,
2, 2, 1,
4, 2, 0,
6, 2, 1,
0, 4, 0,
2, 4, 1,
4, 4, 0,
6, 4, 0,
0, 6, 0,
2, 6, 1,
4, 6, 0,
6, 6, 0}
mSize = 4 : nSize = 4
' creates a 3Dmesh in model space
meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points)
' Change the viewing direction of the viewport
Dim NewDirection() As Double = {-1, -1, 1}
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
acadApp.ZoomAll()
End Sub
*************
GetUCSMatrix
************
sample code from object UCS method GetUCSMatrix in ActiveX Reference Guide
Here is the corrected code. I have added a loop to read and print the matrix values.
The orig program creates a new UCS, makes it active, then draws a circle. That illustrates that coordinate input from ActiveX is always interpreted as World coordinates (VBA ignores the current UCS). The program then runs
newMatrix = UCSobj.GetUCSMatrix
circleobj.Transformby(newMatrix)
which moves the circle from its world coordinates to the equivalent UCS coordinates.
We never have to examine the Matrix or know what its dimensions are. I added a loop to read it. The matrix is a square 4×4. It contains point values as columns. The bottom row seems to be unused.
col1 is the same data as the variable UCSXDIR, its the X vector from the UCS origin.
col2 is the same data as the variable UCSYDIR, its the Y vector from the UCS origin
col3 is the Z vector, which is obtainable from the XY vectors by the right hand rule.
col4 is the origin.
if we were writing our own matrix we would do
dim Matrix(3 , 3) as Double
or
dim Matrix( , ) as Double =
{ {1,0,0,2},
{ 0,1,0,2},
{ 0,0,1,0},
{ 0,0,0,1} }
these are direction vectors.
UCSXDIR = 1,0,0
UCSYDIR = 0,1,0
Z DIR = 0,0,1
absolute point
UCSORG = 2,2,0
this is not the whole story, Transformation Matrices are a fascinating topic in linear algebra. TransformBy has some useful examples, including scaling, which occurs on the main diagonal. ARX Developers Guide (search on transformation matrix) has better help page than ActiveX. First 3 columns are both rotation and scaling. last column is translation. Transformation matrixes can be combined so translation, scaling and rotation are all accomplished in a single operation.
TransformBy is a method of the elementary AcadEntity, meaning it is enabled for every object in the drawing.
Sub Example_GetUCSMatrix()
' This example creates a new UCS and finds the UCS matrix for it.
' It then creates a circle using WCS coordinates and
' transforms the circle for the UCS.
Call Connect_acad()
' Define a new UCS and turn on the UCS icon at the origin.
Dim ucsObj As AcadUCS
Dim origin() As Double = {2, 2, 0}
Dim xAxisPoint() As Double = {3, 2, 0}
Dim yAxisPoint() As Double = {2, 3, 0}
'Dim xAxisPoint() As Double = {4, 4, 0}
'Dim yAxisPoint() As Double = {0, 4, 0}
ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint, yAxisPoint, "UCS1")
ThisDrawing.ActiveUCS = ucsObj
Dim vportObj As AcadViewport
vportObj = ThisDrawing.ActiveViewport
vportObj.UCSIconOn = True
vportObj.UCSIconAtOrigin = True
ThisDrawing.ActiveViewport = vportObj
' Create a circle using WCS coordinates
Dim circleObj As AcadCircle
Dim center() As Double = {1, 1, 0}
Dim radius As Double = 0.5
circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
acadApp.ZoomAll()
' Get the UCS transformation matrix
Dim TransMatrix(,) As Double
TransMatrix = CType(ucsObj.GetUCSMatrix(), Double(,))
Dim str As String
Dim r, c As Integer
For r = 0 To UBound(TransMatrix, 1)
For c = 0 To UBound(TransMatrix, 2)
str = "r = " & CStr(r) & " c = " & CStr(c) & " " & CStr(TransMatrix(r, c))
Debug.Print(str)
Next
Next
' Transform the circle to the UCS coordinates
MsgBox("Transform the circle.", , "GetUCSMatrix Example")
circleObj.TransformBy(TransMatrix)
circleObj.Update()
MsgBox("The circle is transformed.", , "GetUCSMatrix Example")
acadApp.Update()
End Sub
frfly 