The finished product, I left out the layer stuff to keep it clear. I also took off the return value as it cause an error when the OnResnext jump was commented out, I guess there could be a work around like not assigning the objBeam to the db in the function and let the caller add it, I will experiment.
Public Function DrawSection(Optional DWGPath As String = "c:\DCS3d", _
Optional DWGName As String = "310UB040")
' DWGPath - path to dwg-file (w/o slash)
' DWGName - file name w/o extension
' There is no control for these parameters
Dim objLayer As AcadLayer, objBeam As Acad3DSolid, objRegEnt(0) As AcadEntity, objRegion As Variant
Dim objBlockRef As AcadBlockReference, objBlockExplode As Variant
Dim ptInsert As Variant, lCounter As Long
Dim file As String
file = DWGPath & "\" & DWGName & ".dwg"
ptInsert = ThisDrawing.Utility.GetPoint(, "Pick Insertion Point <Cancel> : ")
If IsEmpty(ptInsert) Or Err.Number <> 0 Then Exit Function
If ThisDrawing.Blocks.Item(DWGName) Is Nothing Then
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
file, 1#, 1#, 1#, 0#)
Else
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
DWGName, 1#, 1#, 1#, 0#)
End If
objBlockExplode = objBlockRef.Explode
objBlockRef.Delete
For lCounter = LBound(objBlockExplode) To UBound(objBlockExplode)
If objBlockExplode(lCounter).ObjectName = "AcDbPolyline" Then
Set objRegEnt(0) = objBlockExplode(lCounter)
objRegion = ThisDrawing.ModelSpace.AddRegion(objRegEnt)
Exit For
End If
Next lCounter
Set objBeam = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), 1000#, 0)
objRegion(0).Delete
objRegEnt(0).Delete
ThisDrawing.Regen acActiveViewport
End Function