Question : Entities and SelectionSets

when I try to run this program I get a "Automation Error, Catastrophic Failure" error, stopping at the "for each ent in sset" like, can someone please help?

Dim sset As AcadSelectionSet

Private Sub UpdateFields()
    edtCount.Text = sset.Count & " Objekte"
    btGo.Enabled = (sset.Count > 0)
End Sub

Private Sub btGo_Click()
  UserForm1.hide
  Dim nowpt As AcadPoint
  Dim nowtx As AcadText
  Dim nowmtx As AcadMText
  Dim newpt(1 To 3) As Double
  Dim ent As AcadEntity
  For Each ent In sset
    If (TypeName(ent) = "IAcadText2") Then
      Set nowtx = ent
      newpt(1) = nowtx.InsertionPoint(0) + edtDX.Text
      newpt(2) = nowtx.InsertionPoint(1) + edtDY.Text
      newpt(3) = Trim(nowtx.TextString)
      ThisDrawing.ActiveLayer = CheckLayer("NEWPOINTS")
      ThisDrawing.ModelSpace.AddPoint newpt
    End If
    If (TypeName(ent) = "IAcadMText2") Then
      Set nowmtx = ent
      newpt(1) = nowmtx.InsertionPoint(0) + edtDX.Text
      newpt(2) = nowmtx.InsertionPoint(1) + edtDY.Text
      newpt(3) = Trim(nowmtx.TextString)
      ThisDrawing.ActiveLayer = CheckLayer("NEWPOINTS")
      ThisDrawing.ModelSpace.AddPoint newpt
    End If
  Next ent
  sset.Delete
End Sub

Private Sub CommandButton1_Click()
    UserForm1.hide
'    For I = 0 To ThisDrawing.SelectionSets.Count - 1
'        ThisDrawing.SelectionSets(I).Delete
'    Next I
    Set sset = ThisDrawing.SelectionSets.Add("MySetMP")
    sset.SelectOnScreen
    UpdateFields
    UserForm1.Show
End Sub

Private Sub CommandButton2_Click()
    sset.Clear
    UpdateFields
End Sub

Private Sub CommandButton4_Click()
    Me.hide
End Sub

Answer : Entities and SelectionSets

Hi simtech2007,

I see a couple of problems when I try to run this macro in 2000i.

edtDX.Text, edtDY.Text are not defined before use - at least in the code posted,

If (TypeName(ent) = "IAcadText2") Then

should be

If TypeOf ent Is AcadText Then

"Automation Error, Catastrophic Failure" error <-- may be because the sset object has not been created, check to see if it exists before use

dragontooth

Random Solutions  
 
programming4us programming4us