×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

exploding blocks thru vba

exploding blocks thru vba

exploding blocks thru vba

(OP)
after a block is inserted I want to explode it.
not sure of code to do this

just need the line to explode it...

any ideas

RE: exploding blocks thru vba

From the help file:


RetVal = object.Explode

Object

3DPolyline , BlockRef, ExternalReference, LightweightPolyline, MInsertBlock, Polygonmesh, Polyline, Region
The object or objects this method applies to.

RetVal

Variant (array of objects)
The array of exploded objects.

RE: exploding blocks thru vba

Can't you explode it as it is inserted, similar to the explode option on the Insert menu dialog?

RE: exploding blocks thru vba

Keep in mind after you explode a block in VB, there then exists 2 items. The exploded block ents are "gathered" into an array of the objects and the block still remains also. You will need to delete the block object after exploding. Here is what I use to insert blocks. It is a little wordy but handles a lot of cases...

Public Function InsertBlkRef(ByVal strBlkName As String, _
Optional ByVal blnExplode As Boolean = True, _
Optional ByVal intSpace As Integer = 0, _
Optional ByVal dblScale As Double = 1#, _
Optional ByVal dblInsPnt As Variant, _
Optional ByVal dblRot As Double = 0#, _
Optional ByVal blnLastObj As Boolean = False) As AcadBlockReference
'------------------------------------------------------------------------------
'InsertBlkRef:  Defaults are:
'               EXPLODED
'               MODELSPACE
'               1:1 SCALE
'               0,0 INSERT POINT
'               0 ROTATION
'               True RETURN LAST EXPLODED ITEM (use after explode of block
'                   which reveals another block)
'Arguments:     strBlkName = path and/or filename (i.e. "someblock.dwg")
'               blnExplode = insert exploded TRUE or not explode FALSE
'               intSpace(OPT) = 0 for paperspace and 1 (default) is modelspace
'               dblScale(OPT) = scale, the same for X and Y
'               dblInsPnt(OPT) = insertion point, zero-zero if none given
'               dblRot(OPT) = rotation in degrees (converted to radians
'                               within function), defaults to zero if not given
'Returns:       Block reference (if it is the only item in the block)
'------------------------------------------------------------------------------
Dim acBlkRef As AcadBlockReference
Dim dInsPt(0 To 2) As Double
Dim acBlkEnts
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler

'--------------------------------------------------------------------------
'Set insertion point. Set to 0,0 if none given
'--------------------------------------------------------------------------
If IsMissing(dblInsPnt) Then
    dInsPt(0) = 0#: dInsPt(1) = 0#: dInsPt(2) = 0#
Else
    dInsPt(0) = dblInsPnt(0)
    dInsPt(1) = dblInsPnt(1)
    dInsPt(2) = dblInsPnt(2)
End If

dblRot = DegreesToRadians(dblRot)
'--------------------------------------------------------------------------
'Check if need to add .dwg for pathed files
'--------------------------------------------------------------------------
If InStr(strBlkName, "\") And Not LCase(Right$(strBlkName, 4)) = ".dwg" Then
    strBlkName = strBlkName & ".dwg"
End If
'--------------------------------------------------------------------------
'Set space to insert into. Then insert drawing
'--------------------------------------------------------------------------
If intSpace = 1 Then
    Set acBlkRef = ThisDrawing.PaperSpace.InsertBlock(dInsPt, _
    strBlkName, dblScale, dblScale, dblScale, dblRot)
Else
    Set acBlkRef = ThisDrawing.ModelSpace.InsertBlock(dInsPt, _
    strBlkName, dblScale, dblScale, dblScale, dblRot)
End If

'--------------------------------------------------------------------------
'Make sure block is inserted and explode if required
'--------------------------------------------------------------------------
If Not acBlkRef Is Nothing Then
    If blnExplode Then
        acBlkEnts = acBlkRef.Explode
        acBlkRef.Delete 'Gets rid of original copy, leaves exploded one
        If blnLastObj Then
            Set InsertBlkRef = EntLast 'last modelspace entity
        End If
        Set acBlkRef = Nothing
    Else
        Set InsertBlkRef = acBlkRef
    End If
End If
    
ExitHere:
    Exit Function
ErrHandler:
    Debug.Print vbObjectError + 514, "PP_ACAD Error", _
    "Function 'InsertBlkRef' Failed"
End Function

Public Function DegreesToRadians(dblDegrees As Double) As Double
'------------------------------------------------------------------------------
'DegreesToRadians:   Degrees to radians
'------------------------------------------------------------------------------
    On Error GoTo Err_Control
    DegreesToRadians = dblDegrees / 180 * (Atn(1) * 4)
Exit_Here:
  Exit Function
Err_Control:
    Select Case Err.Number
  'Add additional Case selections here
    Case Else
        MsgBox Err.Description
        Err.Clear
        Resume Exit_Here
    End Select
End Function

"Everybody is ignorant, only on different subjects." — Will Rogers

RE: exploding blocks thru vba

(OP)
thanks to all the examples gave me exactly what i needed

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources