Error on making a Text object

[AstroNout]

Hi all!

 

The weather isn't too good over here, so it's programmingtime again. Could you get me out of this one? It should mark the height of a block, but I get stuck when I try to put the text on the insertionpoint of the block. Not too complicated I guessed. I guessed wrong...

 

The error states: "Method 'Add3DMesh' of object 'IAcadModelSpace' failed."

 

Sub BlockHeight()
Dim aEnt As AcadEntity
Dim aBlock As AcadBlockReference
Dim aText As AcadText
Dim sText As String
Dim NewLayer As AcadLayer
Dim retValue As Variant
Dim retCoord(0 To 2) As Double
Dim attrib As Variant
Dim sset As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim InsertionPoint As Variant

FilterType(0) = 8
FilterData(0) = "OCT_KDT"

On error GoTo Delete

Set sset = ThisDrawing.SelectionSets.Add("sset")
sset.Select acSelectionSetAll, , , FilterType, FilterData

On error goto Errorhandling
For Each aEnt In sset
   If TypeOf aEnt Is AcadBlockReference Then
       Set aBlock = aEnt
       retValue = aBlock.GetAttributes
       For Each attrib In retValue
           If attrib.TagString = "LAYER" Then
               sText = attrib.TextString
           End If
       Next attrib

       If sText Like "N_WRI*" Then
           Set NewLayer = ThisDrawing.Layers.Add("N_LOW")
           sText = aBlock.InsertionPoint(2)
           InsertionPoint = aBlock.InsertionPoint
           Set aText = ThisDrawing.ModelSpace.AddText(sText, InsertionPoint, 0)
           aText.Layer = "N_LOW"
           aText.StyleName = "OCTOPUS"
           aText.Height = 0.5
           aText.Rotation = 0
           NewLayer.Color = acYellow
       End If
   End If
Next aEnt
sset.Delete
Exit Sub

Delete:
ThisDrawing.SelectionSets.Item("sset").Delete
Resume

Errorhandling:
ThisDrawing.SelectionSets.Item("sset").Delete

End Sub