Mick, I added
[font=Verdana]Dim ucs As AcadUCS
Set ucs = GetActiveUcs
SetOrthoUCS[/font]
ptInsert(0) = 0: ptInsert(1) = 0: ptInsert(2) = 0
If IsEmpty(ptInsert) Or Err.Number <> 0 Then Exit Sub
If ThisDrawing.Blocks.Item(DWGName) Is Nothing Then
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
DWGPath & "\" & DWGName & ".dwg", 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), height, 0)
objRegion(0).Delete
objRegEnt(0).Delete
[font=Verdana] objBeam.TransformBy (ThisDrawing.ActiveUCS.GetUCSMatrix)
ThisDrawing.ActiveUCS = ucs[/font]
and it always seemed to work, can you post a dwg where it doesn't?