There are several ways of opening a VBA script file in AutoCAD. Some scripts are embedded in a drawing and are opened automatically when the drawing is opened. For separate scripts AutoCAD comes with a VBA Manager which can open and close scripts. Drag-and-dropping a file into a drawing opens it and using the VBALOAD command.
VBAUNLOAD can be used to unload a script.
AutoCAD uses arcane programming terminology. A macro is a subroutine of a function. A VBA script file is called a project (Supposedly because a script file potentially consists of multiple "macros").
Each script files consists of at least one function. Once a script has been opened VBARUN executes a function. Alternatively, AutoCAD comes with a VBA IDE which allows you to edit and run loaded functions.
VBAIDE
Brings up the VBA IDE. The VBA IDE allows you to edit, run, and debug programs interactively. Although the VBA IDE is invoked only when AutoCAD is running, it can be minimized, opened, and closed independent of the AutoCAD Application window.
VBALOAD
Loads a VBA project into the current AutoCAD session.
VBARUN
Runs a VBA macro from the Macros dialog box or from the AutoCAD command line.
VBAUNLOAD
Unloads a VBA project from the current AutoCAD session.
If the VBA project is modified but not saved, the user is asked to save it with the Save Project dialog box (or command line equivalent).
VBAMAN
Displays the VBA Manager allowing you to view, create, load, close, embed, and extract projects.
VBASTMT
Executes a VBA statement from the AutoCAD command line.
Public Sub Drawline() Dim lineobj As AcadLine Dim StartPoint(0 To 2) As Double Dim EndPoint(0 To 2) As Double 'Define startpoint the line point StartPoint(0) = 0: StartPoint(1) = 0: StartPoint(2) = 0 'Define endpoint the line point EndPoint(0) = 10: EndPoint(1) = 10: EndPoint(2) = 0 'Create a line in model space Set lineobj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint) ThisDrawing.SaveAs Drawline.dwg End Sub
MsgBox "Rotation completed.", , "Rotate Example"
Dim sset As AcadSelectionSet Set sset = ThisDrawing.SelectionSets.Add("SSET") sset.Select acSelectionSetAll
Sub abc() Dim SSet As AcadSelectionSet ' or - Dim SSet As Object ' for late binding Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim Groupcode As Variant Dim DataValue As Variant FilterType(0) = 67 FilterData(0) = 0 ' ModelSpace Groupcode = FilterType DataValue = FilterData On Error Resume Next ActiveDocument.SelectionSets.Item("TEST_SSET").Delete Set SSet = ActiveDocument.SelectionSets.Add("TEST_SSET") On Error GoTo 0 SSet.Select acSelectionSetAll, , , Groupcode, DataValue End Sub
Sub Example_Move() ' This example creates a circle and then performs ' a move on that circle. ' Create the circle Dim circleObj As AcadCircle Dim center(0 To 2) As Double Dim radius As Double center(0) = 2#: center(1) = 2#: center(2) = 0# radius = 0.5 Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius) ZoomAll ' Define the points that make up the move vector Dim point1(0 To 2) As Double Dim point2(0 To 2) As Double point1(0) = 0: point1(1) = 0: point1(2) = 0 point2(0) = 2: point2(1) = 0: point2(2) = 0 MsgBox "Move the circle 2 units in the X direction.", , "Move Example" ' Move the circle circleObj.Move point1, point2 ZoomAll MsgBox "Move completed.", , "Move Example" End Sub
Public Sub moveAll() Dim sset As AcadSelectionSet Set sset = ThisDrawing.SelectionSets.Add("SSET2") sset.Select acSelectionSetAll Dim point1(0 To 2) As Double Dim point2(0 To 2) As Double point1(0) = 0: point1(1) = 0: point1(2) = 0 point2(0) = 20000: point2(1) = 0: point2(2) = 0 ' Move the circle ' sset.Move point1, point2 For Each ent In sset ent.Move point1, point2 Next ZoomAll MsgBox "Move completed.", , "Move Exampl" End Sub
Sub Example_Rotate() ' This example creates a lightweight polyline ' and then rotates that polyline. ' Create the polyline Dim plineObj As AcadLWPolyline Dim points(0 To 11) As Double points(0) = 1: points(1) = 2 points(2) = 1: points(3) = 3 points(4) = 2: points(5) = 3 points(6) = 3: points(7) = 3 points(8) = 4: points(9) = 4 points(10) = 4: points(11) = 2 Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True ZoomAll MsgBox "Rotate the polyline by 45 degrees.", , "Rotate Example" ' Define the rotation Dim basePoint(0 To 2) As Double Dim rotationAngle As Double basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0 rotationAngle = 0.7853981 ' 45 degrees ' Rotate the polyline plineObj.Rotate basePoint, rotationAngle ZoomAll MsgBox "Rotation completed.", , "Rotate Example" End Sub
Sub Ch3_NewDrawing() Dim docObj As AcadDocument Set docObj = ThisDrawing.Application.Documents.Add End Sub
Sub Example_Open() ' The following example opens "C:\AutoCAD\Sample\city map.dwg" file. ' This drawing may not exist on your system. Change the drawing ' path and name to reflect a valid AutoCAD drawing on your system. ThisDrawing.Application.Documents.Open ("C:\AutoCAD\Sample\city map.dwg") End Sub
Sub Ch3_OpenDrawing() Dim dwgName As String dwgName = "c:\campus.dwg" If Dir(dwgName) <> "" Then ThisDrawing.Application.Documents.Open dwgName Else MsgBox "File " & dwgName & " does not exist." End If End Sub
Sub Example_Save() ' The following example saves current drawing ThisDrawing.Save End Sub
Sub Example_SaveAs() ' The following example saves current drawing as "test.dwg" ThisDrawing.SaveAs ("test.dwg") End Sub
Sub closeCurrentDrawing() ThisDrawing.Close End Sub
Function getDrawingList(Folder As String) As Collection Dim fs, f, f1, fc Dim mycoll As New Collection Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(Folder) Set fc = f.Files For Each f1 In fc If UCase(Right(f1.Name, 4)) = UCase(".dwg") Then mycoll.Add f1.PATH End If Next Set getDrawingList = mycoll End Function Sub transformAllInDir() Dim drawings As Collection Set drawings = getDrawingList("C:\test") For Each drawing In drawings MsgBox drawing Next drawing End Sub
Sub Example_SendCommand() ' This example sends a command for evaluation to the AutoCAD command line ' of a particular drawing ' Create a Circle in the active drawing and ' zoom to display the entire circle ThisDrawing.SendCommand "_Circle" & vbCr & "2,2,0" & vbCr & "4" & vbCr ThisDrawing.SendCommand "_zoom" & vbCr & "a" & vbCr ' Refresh view ThisDrawing.Regen acAllViewports MsgBox "A circle command has been sent to the command line of the current drawing." End Sub
Function getActiveUcs() As AcadUCS ' get the active UCS ' if the UCS is not saved, save it Dim Origin Dim xaxis Dim yaxis Dim Zero(0 To 2) As Double Zero(0) = 0: Zero(1) = 0: Zero(2) = 0 Dim currentUCS As String currentUCSName = ThisDrawing.GetVariable("UCSNAME") If currentUCSName = "" Then ' Current UCS is not saved so get the data and save it ' A ucs is saved when a user makes and saves one or ' a user clicks on an isoview button If ThisDrawing.GetVariable("WORLDUCS") = 1 Then ' active UCS is identical to WCS xaxis = Zero: yaxis = Zero xaxis(0) = 1: yaxis(1) = 1 Set getActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, xaxis, yaxis, "World") Else Origin = ThisDrawing.GetVariable("UCSORG") xaxis = ThisDrawing.GetVariable("UCSXDIR") yaxis = ThisDrawing.GetVariable("UCSYDIR") Set getActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, xaxis, yaxis, "Active") 'Changing the origin later stops the error message '-2145320930 UCS X axis and Y axis are not perpendicular getActiveUcs.Origin = Origin ThisDrawing.ActiveUCS = getActiveUcs End If Else Set getActiveUcs = ThisDrawing.UserCoordinateSystems.Item(currentUCSName) End If End Function
Dim ucsObj As AcadUCS Dim origin(0 To 2) As Double Dim xAxisPoint(0 To 2) As Double Dim yAxisPoint(0 To 2) As Double origin(0) = -326482.9747: origin(1) = 80747.2734: origin(2) = 0 xAxisPoint(0) = 0.9828: xAxisPoint(1) = 0.1849: xAxisPoint(2) = 0 yAxisPoint(0) = -0.1849: yAxisPoint(1) = 0.9828: yAxisPoint(2) = 0 ' Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint, yAxisPoint, "UCSMe") Set ucsObj = ThisDrawing.UserCoordinateSystems.Improve(origin, xAxisPoint, yAxisPoint, "UCSMe") ThisDrawing.ActiveUCS = ucsObj
ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("TempWorld")
Sub angleFromXAxis() Dim angRad As Double Dim angDeg As Double Dim p1(0 To 2) As Double Dim p2(0 To 2) As Double p1(0) = 0: p1(1) = 0: p1(2) = 0 p2(0) = 0.9828: p2(1) = 0.1849: p2(2) = 0 angRad = ThisDrawing.Utility.angleFromXAxis(p1, p2) angDeg = (180 * angRad) / 3.14159265358979 'andRad = (3.14159265358979 * andDeg)/180 MsgBox angDeg End Sub
Sub drawToUCS Dim XYZ(0 To 2) As Double Dim TestBlock As AcadBlockReference Dim ucsObj As AcadUCS Dim TransMatrix As Variant Set ucsObj = ThisDrawing.UserCoordinateSystems.Item("MYUCS") XYZ(0) = 0 XYZ(1) = 0 XYZ(2) = 0 Set TestBlock = ThisDrawing.ModelSpace.InsertBlock(XYZ, "MYBLOCK", 1, 1, 1, 0) TransMatrix = ucsObj.GetUCSMatrix() TestBlock.TransformBy (TransMatrix) TestBlock.Update End Sub