20 | 09 | 2017

Draw Beams and get Parts List with Lengths

In a lot of industries extrusions are used. For instance the branches that fabricate Window Frames, they use many of the same profiles with different dimensions. With the help of VBA we are going to create a program that can draw 3d and faked extrusions and on top of that a routine that can get the type and the length of the beam. 

 

--------------------------------------------------------------------------------
To create a beam or extrusion effect we first have to start of with creating base block. Create three random block objects with a thickness of 1 mm. In this tutorial we used three squares with different dimentions called Beam 45x45; Beam 45x90 and Beam 90x90. And these are saves at C:\

'One of the blocks used in this tutorial (Beam 45x90)'

This 1mm thick block will be the base of the beam. To create the impression of a extruded beam we will use the Z scale to add length to the object.

 After creating the blocks open up a new project and create a userform called FRMBeam. Add controls like the image below. 

 

'Impression of FRMBeam'

Add following code to the form:

Private Sub CMBgetbeam_Click()
 
'****************************************
'*** Code from VisibleVisual.com ********
'****************************************
 
FRMcount.Show
End Sub
 
Private Sub CMBinsert_Click()
Me.Hide
 
On Error Resume Next
 
If OPTbeam1 = True Then
insertBlock "C:\Beam 45x45.dwg"
ElseIf OPTbeam2 = True Then
insertBlock "C:\Beam 45x90.dwg"
ElseIf OPTbeam3 = True Then
insertBlock "C:\Beam 90x90.dwg"
End If
 
End Sub
 
Sub insertBlock(ByVal dwgname As String)
 
On Error Resume Next
 
    Dim blockRefObj As AcadBlockReference
    Dim pnt, pnt2 As Variant
    Dim prompt1, prompt2 As String
 
 
    ThisDrawing.ActiveSpace = acModelSpace
 
    'Ask user for insert point
    prompt1 = vbCrLf & "Enter block insert point: "
    pnt = ThisDrawing.Utility.GetPoint(, prompt1)
 
    'Insert block at specified point
    Set blockRefObj = ThisDrawing.ModelSpace.insertBlock(pnt, dwgname, 1#, 1#, 1#, 0)
 
    'Ask user for rotation angle
 
    rotation = ThisDrawing.Utility.GetAngle(pnt, "Select Rotation Angle:")
    If Err Then rotation = 0
 
    blockRefObj.Rotate pnt, rotation
 
    'Ask user for extrusion length
    pnt2 = ThisDrawing.Utility.GetPoint(pnt, "Select end point or enter length (mm):")
 
    'Give the block length by changing the Z scale of the block.
    blockRefObj.ZScaleFactor = Distance(pnt, pnt2)
 
Exit Sub
 
errorhandler:
End Sub
 
 
Function Distance(Point1, Point2) As Double
'This function is used to get  the distance between two points
 
Dim dist As Double
 
On Error Resume Next
 
For I = LBound(Point1) To UBound(Point1)
 
dist = dist + ((Point1(I) - Point2(I)) ^ 2)
 
If Err Then Exit For
 
Next
Distance = Sqr(dist)
End Function
[/code]  

'The code above makes creation of beams easy but there is another benefit. We can create a parts list including extrusion lengths.
'To do so create a new userform called FRMcount and add a listview with three columns called List1.

 Add the following code to this form

[code]

Private Sub UserForm_Initialize()

'on startup code blockcount
blockcount
 
End Sub
 
 
Public Sub blockcount()
 
Dim objAcEnt As AcadEntity
Dim objblock As AcadBlock
 
'first clear the listview
List1.Clear
 
For Each objAcEnt In ThisDrawing.ModelSpace
 
If TypeOf objAcEnt Is AcadBlockReference Then
 
With List1
 
    Length = 0
 
    'Check is block has a Z scale factor and make it positive
    If objAcEnt.ZScaleFactor < -1 Then Length = Round(-objAcEnt.ZScaleFactor, 1)
    If objAcEnt.ZScaleFactor > 1 Then Length = Round(objAcEnt.ZScaleFactor, 1)
 
        If .ListCount = 0 Then
        .AddItem objAcEnt.Name
        .List(I, 1) = 1
        .List(I, 2) = Round(Length, 0)
        Else
 
         For I = 0 To .ListCount - 1
            'Search if block exist and if so if the length is the same
            If .List(I, 0) = objAcEnt.Name Then
 
            Length1 = Round(.List(I, 2), 0)
            Length2 = Round(Length, 0)
 
            If Length1 = Length2 Then
                If .List(I, 1) > 0 Then
                .List(I, 1) = .List(I, 1) + 1
                GoTo volgende
                End If
 
            ElseIf Length = 0 Then
                If .List(I, 1) > 0 Then
                .List(I, 1) = .List(I, 1) + 1
                GoTo volgende
                End If
            End If
 
            End If
 
         Next I
 
        .AddItem objAcEnt.Name
        .List(I, 1) = 1
        If Length = 0 Then
        Else
        .List(I, 2) = Round(Length, 0)
        End If
 
        End If
 
volgende:
 
End With
End If
 
Next
 
End Sub

 Now that this code is done use the FRMbeam form to create a small construction as shown below

"The result from the code above"

Now hit the get beams button on the FRMbeams form and the following window will pop up showing all blocks and extrusions.

Download AutoCad all files used in this tutorial below (registered users only):

Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2353578
Latest Articles