|
|
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
|
|
|
|
|