ThisDrawing.ActiveSelectionSet cannot clear

[dancalgary]

hello everybody
I have created a routine that changes text properties
But I have a problem
I cannot clear the active selection set
when i run the second time and if i do not select anything the active selection set has the previous objects into it


i have tried with pick first sel set and nothing
the resulting selection set is empty
any Ideea?

Thanks

My code:
Sub oblique1()

Dim Sel66, Sel67 As AcadSelectionSet
Dim OBJ66 As AcadEntity
Dim Text66 As AcadText
Dim Style66 As AcadTextStyle
Dim Mtext66 As AcadMText

MsgBox ThisDrawing.ActiveSelectionSet.Name & vbCrLf & ThisDrawing.ActiveSelectionSet.Count
On Error GoTo 1:
ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles("STYLE1")

On Error Resume Next
Set Sel66 = ThisDrawing.ActiveSelectionSet


For Each OBJ66 In Sel66

If OBJ66.ObjectName = "AcDbText" Then
Set Text66 = OBJ66
Text66.ObliqueAngle = 15 * 4 * Atn(1) / 180
Text66.StyleName = "STYLE1"
Text66.Height = 10
ThisDrawing.ActiveSelectionSet.RemoveItems (Text66)
End If

If OBJ66.ObjectName = "AcDbMText" Then
Set Mtext66 = OBJ66
Mtext66.ObliqueAngle = 15 * 4 * Atn(1) / 180
Mtext66.StyleName = "STYLE1"
Mtext66.Height = 10
End If


Next

Set Sel66 = Nothing
ThisDrawing.ActiveSelectionSet.Clear
MsgBox " ACTIVE IS " & ThisDrawing.ActiveSelectionSet.Count

Exit Sub
1: MsgBox "Style does not exist"

End Sub

[Anonymous]

Take a lool at this post. At the time of my posting is 3 down from where your post is.

http://discussion.autodesk.com/thread.jspa?threadID=572379

[dancalgary]

I have done all of this
I can not clear the active selection set

anyone has a new idea?
thanks

Dim Sel7 As AcadSelectionSet
Dim sel7_s As AcadSelectionSets
On Error Resume Next
Set sel7_s = ThisDrawing.SelectionSets
sel7_s.Item("PICKFIRST").Delete
Set Sel7 = ThisDrawing.PickfirstSelectionSet
ThisDrawing.ActiveSelectionSet.Clear
ThisDrawing.ActiveSelectionSet.Update
ThisDrawing.ActiveSelectionSet.Delete

[Anonymous]

Place this function in your Thisdrawing module. Watch out for word wrap...

Public Function CreateSelectionSet(sname As String) As AcadSelectionSet
Dim ss As AcadSelectionSet
For Each ss In ThisDrawing.SelectionSets
If ss.Name = sname Then
ss.Delete
Exit For
End If
Next ss
Set CreateSelectionSet = ThisDrawing.SelectionSets.Add(sname)
End Function

You can call it like this from anywhere in your DVB project:
set myss = thisdrawing.createselection("ss")

I hope this is what you're looking for,
Fred

[Anonymous]

Correction:

You can call it like this from anywhere in your DVB project:
set myss = Thisdrawing.CreateSelectionSet("ss")

[dancalgary]

I have done a SUB that changes the height of the text
First I select the thext and after I run the SUB
everything works
BUT
after I run the SUB
and nothing is selected
if i run the SUB again is affecting the objects that are in activeselectionset
I want to be able to clear active selection set
and i can not

why i use active selection set
because is the only way to aply changes to allready selected entities

or I am wrong??
i can do this different?
thanks
dan


my code:
Sub oblique1()

Dim Sel66 As AcadSelectionSet
Dim OBJ66 As AcadEntity
Dim Text66 As AcadText
Dim Style66 As AcadTextStyle
Dim Mtext66 As AcadMText

On Error GoTo 1:
ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles("STYLE1")

On Error Resume Next
Set Sel55 = ThisDrawing.ActiveSelectionSet



For Each OBJ66 In Sel66

If OBJ66.ObjectName = "AcDbText" Then
Set Text66 = OBJ66
Text66.ObliqueAngle = 15 * 4 * Atn(1) / 180
Text66.StyleName = "STYLE1"
Text66.Height = 10
End If

If OBJ66.ObjectName = "AcDbMText" Then
Set Mtext66 = OBJ66
Mtext66.ObliqueAngle = 15 * 4 * Atn(1) / 180
Mtext66.StyleName = "STYLE1"
Mtext66.Height = 10
End If


Next




Exit Sub
1: MsgBox "Style does not exist"

End Sub

[Anonymous]

If you will see in Help MText don't have
an ObliqueAngle property
You can change it with new textstyle,
or with formatting text (bad idea though)
Here is very quick and basic example

Hth

~'J'~

Option Explicit
' Make sure that in your VBAIDE options are set
' to Break on Unhandled Errors in the Error Trapping field
Public Const PI = 3.14159265358979
Sub ChToOblique()

Dim oSet As AcadSelectionSet
Dim oEntity As AcadEntity
Dim oText As AcadText
Dim oStyle As AcadTextStyle
Dim oStyleNew As AcadTextStyle
Dim oMtext As AcadMText
Dim ffname As String

On Error GoTo Err_Control

If Not IsStyleExist("OBLIQUE_STYLE1") Then
Dim typeFace As String
Dim Bold As Boolean
Dim Italic As Boolean
Dim charSet As Long
Dim PitchandFamily As Long

Set oStyle = ThisDrawing.TextStyles("STYLE1")
Set oStyleNew = ThisDrawing.TextStyles.Add("OBLIQUE_STYLE1")
oStyleNew.Height = oStyle.Height
oStyleNew.ObliqueAngle = dtr(15#)
oStyleNew.Width = oStyle.Width
Dim fontPath As String
fontPath = "C:\Program Files\AutoCAD 2007\Fonts\" & oStyle.fontFile
ffname = "C:\Program Files\AutoCAD 2007\Fonts\" & oStyle.fontFile
If Dir(fontPath) "" Then
oStyleNew.fontFile = ffname
ThisDrawing.Utility.Prompt (vbCr & ffname) ' debug only
Else
MsgBox "Change a font file path to your suit"
Exit Sub
End If

ThisDrawing.ActiveTextStyle = oStyleNew

Else
ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles("OBLIQUE_STYLE1")
End If
ThisDrawing.Utility.Prompt (vbCr & ThisDrawing.ActiveTextStyle.Name) ' debug only

Set oSet = ThisDrawing.ActiveSelectionSet
ThisDrawing.Utility.Prompt (vbCr & oSet.Count) ' debug only

For Each oEntity In oSet
If oEntity.ObjectName = "AcDbText" Then
Set oText = oEntity
oText.StyleName = "OBLIQUE_STYLE1"
oText.ObliqueAngle = dtr(15#)
oText.Height = 10
oText.Update
ElseIf oEntity.ObjectName = "AcDbMText" Then
Set oMtext = oEntity
oMtext.StyleName = "OBLIQUE_STYLE1"
oMtext.Height = 10
oMtext.Update
Else
' do nothing
End If

Next

ThisDrawing.Regen acActiveViewport

oSet.Clear
Set oSet = Nothing

Exit Sub

Err_Control:
If Err.Number 0 Then MsgBox Err.Description

End Sub
Function IsStyleExist(stName As String) As Boolean
' David Kisleika's method
Dim oStyle As AcadTextStyle
On Error Resume Next
Set oStyle = ThisDrawing.TextStyles(stName)
IsStyleExist = (Err.Number = 0)
End Function

'convert degrees to radians
Public Function dtr(a As Double)
dtr = (a / 180) * PI
End Function

[Anonymous]

Although Fatty's response is excellent, I thought you should know it still looks like you have an issue with your selection set because you are not using the public function above and your code is out of order. If the selection set exists you have to delete it first before it is set. The function will check to see if it is there first. What you describe, working once and then not after, is typical of setting it BZEFORE checking for its existence and deleting it if it does.

[Anonymous]

Can you guys help me out here? I'm at a loss. What is the difference between "Deleting, Recreating, then Using" and "Clearing then Using" a SelectionSet?

Thanks,
Fred

[Ed.Jobe]

Probably what is confusing is thinking of the objects as a selectionset as opposed to the AcadSelectionset object. The Selectionsets collection cannot accept duplicate names in its index, as is true with any collection or hash table. Thus, you need to handle the error that would be generated if you try to add a new ss to the collection using a name that already exists. If no ss with that name exists, you can add it. Once you do, you can add objects to its collection. This is what you probably are thinking of as a "selectionset", the acad entities themselves. But a selectionset can be empty, its the container that's the selectionset. If you use Selectionset.Erase, you delete the objects in the ss, but not the ss. If you use Selectionset.Delete, you delete the ss, but not the entities in it.

[Anonymous]

Think of the ActiveSelectionSet as being the previously selected objects, like move,p or move previous. So don't use it.
PickfirstSelectionSet gives the preselected objects like when you select some objects then get into the move command. If there is nothing preselected it will show a count of 0. The pickfirstselectionset sometimes throws a wobbler so it's best to start a new selectionset and do what you need to do with the set in one hit.