VBA Express : AutoCAD - Create A Slot Programmatically

AutoCAD

Create A Slot Programmatically

Ease of Use

Easy

Version tested with

2004

Submitted by:

lucas

Description:

Creates a slot to dimensions determined by the user.

Discussion:

Architectural draftsmen and detailers often need to draw slotted holes to make bolt-up connections easier(among other uses). This automates doing that with user defined options on the insertion point, length and width of the slot.

Code:

instructions for use

			Put this code In a standard module: 
 
Option Explicit 
Const pi = 3.14159265358979 
 'create Pi as a constant
Public SlotLengths As Double '<- holds last length entered
Public SlotDias As Double '<- holds last diameter entered
 'This function converts Degrees to Radians
Function dtr(a As Double) As Double 
    dtr = (a / 180) * pi 
End Function 
 
 
Sub Slots() 
     'define the function
     
    Dim InsertPoint As Variant 
    Dim SlotLength As Double 
    Dim SlotDia As Double 
    Dim Prompt1 As String 
    Dim Prompt2 As String 
    Dim Prompt3 As String 
    Dim pt1 As Variant 
    Dim pt2 As Variant 
    Dim pt3 As Variant 
    Dim pt4 As Variant 
    Dim pt5 As Variant 
    Dim pt6 As Variant 
    Dim pt7 As Variant 
    Dim LineObj As AcadLine 
    Dim ArcObj As AcadArc 
     'declare all variables
     
    On Error Resume Next 
    Prompt1 = vbCrLf & "Insertion Point : " 
     'store the prompt
     
    InsertPoint = ThisDrawing.Utility.GetPoint(, Prompt1) 
     'get the insertion point
     
    Prompt2 = vbCrLf & "Slot Length (Inches)<" & Format(SlotLengths, "0.0000") & ">: " 
     'store the prompt
    SlotLength = ThisDrawing.Utility.GetReal(Prompt2) 
     'get the Slot Length in inches
     'get the length if it is 0 then set it to the saved last length
    If SlotLength = 0 Then 
         'saved length entered
        SlotLength = SlotLengths 
    Else 
         'save the number entered
        SlotLengths = SlotLength 
    End If 
     
     
    Prompt3 = vbCrLf & "Slot Diameter (Inches)<" & Format(SlotDias, "0.0000") & ">: " 
     'store the prompt
    SlotDia = ThisDrawing.Utility.GetReal(Prompt3) 
     'get the Slot Diameter in inches
     'get the Diameter if it is 0 then set it to the saved last Diameter
    If SlotDia = 0 Then 
         'saved diameter entered
        SlotDia = SlotDias 
    Else 
         'save the number entered
        SlotDias = SlotDia 
    End If 
     
     
    pt1 = ThisDrawing.Utility. _ 
    PolarPoint(InsertPoint, dtr(270#), SlotDia / 2) 
    pt2 = ThisDrawing.Utility. _ 
    PolarPoint(pt1, dtr(180#), SlotLength / 2) 
    pt3 = ThisDrawing.Utility. _ 
    PolarPoint(pt2, dtr(90#), SlotDia) 
    pt4 = ThisDrawing.Utility. _ 
    PolarPoint(pt3, dtr(0#), SlotLength) 
    pt5 = ThisDrawing.Utility. _ 
    PolarPoint(pt4, dtr(270#), SlotDia) 
    pt6 = ThisDrawing.Utility. _ 
    PolarPoint(InsertPoint, dtr(180#), SlotLength / 2) 
    pt7 = ThisDrawing.Utility. _ 
    PolarPoint(InsertPoint, dtr(0#), SlotLength / 2) 
     'calculate all the points using the PolarPoint Function
     
    Set LineObj = ThisDrawing.ModelSpace. _ 
    AddLine(pt5, pt2) 
    Set LineObj = ThisDrawing.ModelSpace. _ 
    AddLine(pt3, pt4) 
    Set ArcObj = ThisDrawing.ModelSpace. _ 
    AddArc(pt6, SlotDia / 2, dtr(90), dtr(270)) 
    Set ArcObj = ThisDrawing.ModelSpace. _ 
    AddArc(pt7, SlotDia / 2, dtr(270), dtr(90)) 
     'Draw the Slotted Hole
     
     'get endpoint for center line
    pt1 = ThisDrawing.Utility. _ 
    PolarPoint(pt7, dtr(0#), SlotDia + 0.25) 
     'get endpoint for center line
    pt2 = ThisDrawing.Utility. _ 
    PolarPoint(pt6, dtr(180#), SlotDia + 0.25) 
     'draw center horizontal line
    Set LineObj = ThisDrawing.ModelSpace. _ 
    AddLine(pt1, pt2) 
     'change layer to center
    LineObj.Layer = "center" 
     'get endpoint for center line
    pt1 = ThisDrawing.Utility. _ 
    PolarPoint(InsertPoint, dtr(90#), SlotDia + 0.25) 
     'get endpoint for center line
    pt2 = ThisDrawing.Utility. _ 
    PolarPoint(InsertPoint, dtr(270#), SlotDia + 0.25) 
     'draw center vertical line
    Set LineObj = ThisDrawing.ModelSpace. _ 
    AddLine(pt1, pt2) 
    LineObj.Layer = "center" 
     
     
    ActiveDocument.Regen acActiveViewport 
     'regen the active document to make acad update the screen
    Set LineObj = Nothing 
    Set ArcObj = Nothing 
     
    Err.Clear 'just in case of error
    On Error GoTo 0 
     'turn off error trapping
End Sub

How to use:

Copy the MakeSlot.dvb file to a permanent location on your hard drive. You may wish to set up a directory for your vba routines under your ACAD installation directory. I have one directory for VBA and one for Lisp routines.
Open any CAD File
Click on Tools on the main menubar and from the selections click on Load Application.
You are now looking at the Load/Unload Applications dialog box
In the top window browse to the location where you put your MakeSlot.dvb file and select it.
Click the Load button that is located just below the window.
At the bottom of the dialog box You will get a message saying "MakeSlot.dvb loaded successfully"
Click on the close button.
Note: If you wish to view the code or alter it go to tools on the main menu click on macro then click on Visual Basic editor. You can insert a module here and paste the code in manually if you want to.

Test the code:

Go back to the main tools menu and click on Macro then on Macro's
In the Macros dialog box You will see The file path-Name of your file(MakeSlot.dvb) followed by the module name.
Highlight the line described above and click the Run button.
On the command line(located at the bottom of the screen) you will be prompted for an insertion point.
Select the location on the screen where you want to conctruct your slot by clicking on the screen.
You will then be prompted for the slot length. You may enter decimals or fractions(15-1/2) for 1' 3-1/2" etc.
This will be center to center of the circles on each end of the slot, not the overall length of the slot.
After entering your slot length, hit enter.
Next you will be prompted for the slot diameter.
after you enter the diameter and hit enter your slot will be constructed.

Sample File:

MakeSlot.zip 15.49KB

Approved by mdmackillop

This entry has been viewed 97 times.