Strict Standards: Only variables should be passed by reference in /home/stefanix/stefanix.net/doku.php on line 71

Warning: Cannot modify header information - headers already sent by (output started at /home/stefanix/stefanix.net/doku.php:71) in /home/stefanix/stefanix.net/inc/actions.php on line 154
stefanix :: autocad-vba
ABOUT PROJECTS RESUME
autocad-vba

Intro

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.

VBA Commands

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.

Commands

  • ZOOM a
  • PAN
  • LINE
  • PLINE
  • REC
  • CIRCLE
  • ARC
  • ERASE
  • EXTEND
  • TRIM
  • COPY
  • MIRROR
  • OFFSET
  • MOVE
  • ROTATE
  • FILLET
  • DIST
  • VBALOAD
  • VBAUNLOAD
  • VBARUN
  • VBAIDE

AutoCad-specific VBA things

  • ThisDrawing refers to the currently open dwg file.

Some Example Code

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

Text Output

MsgBox "Rotation completed.", , "Rotate Example"

Select All

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

Move

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

Rotate

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

LOAD/SAVE

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

Send Command

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

UCS

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
Show pagesource Old revisions Backlinks Index Recent changes
autocad-vba.txt · Last modified: 2009/04/26 01:30 (external edit)

Strict Standards: Only variables should be passed by reference in /home/stefanix/stefanix.net/doku.php on line 79