Author Topic: Replacing Att Def's with text.  (Read 14817 times)

0 Members and 1 Guest are viewing this topic.

TR

  • Guest
Replacing Att Def's with text.
« on: April 12, 2004, 07:46:35 PM »
I'm trying to replace all attribute definitions in modelspace with text. The following code replaces all the attributes with text, but for some reason moves some of them to 0,0,0. Anyone have any ideas?

Code: [Select]

Public Sub remove_attdef()

    Dim SelSet As AcadSelectionSet
    Dim AT As AcadAttribute
    Dim FilterType(0 To 0) As Integer
    Dim FilterData(0 To 0) As Variant
    Dim TXT As AcadText
    Dim YesNo

    'select attribute definitions
    FilterType(0) = 0
    FilterData(0) = "ATTDEF"

    On Error GoTo Exit_Error
        ThisDrawing.SelectionSets.Add "SelSet"
        Set SelSet = ThisDrawing.SelectionSets("SelSet")
        SelSet.Clear

    SelSet.Select acSelectionSetAll, , , FilterType, FilterData

    'if the count is greater than 1 then there are attribute definitions in
modelspace
    If SelSet.Count <> 0 Then
        YesNo = MsgBox("You Have " & SelSet.Count & " Attribute
Definition(s) in " & ThisDrawing.Name & ". This Program will attempt to
convert them to Text.", _
        vbYesNo + vbCritical + vbDefaultButton1)
        'if "Ok" is pressed then try to replace all of the attribute
definitions with text that has the same properties.
        If YesNo = vbYes Then
            For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next
        End If
    End If
    'clear the selection set
    SelSet.Clear
    'rescan the drawing for attribute definitions
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if it the count is zero then it worked.
    If SelSet.Count = 0 Then
        MsgBox "All attributes were converted to text."
    Else:
        MsgBox "Failed to convert all attributes to text."
    End If


Exit_Error:
   SelSet.Delete
   Set SelSet = Nothing
   Set AT = Nothing
   Set TXT = Nothing
End Sub

Ron Heigh

  • Guest
Replacing Att Def's with text.
« Reply #1 on: April 12, 2004, 10:38:36 PM »
have you tried "burst"?

Ron Heigh

  • Guest
Replacing Att Def's with text.
« Reply #2 on: April 12, 2004, 10:57:46 PM »
what if you add
Code: [Select]
Dim insertionZero(0 To 2) As Double
insertionZero(0) = 0: insertionZero(1) = 0: insertionZero(2) = 0

TXT.Move insertionZero, AT.InsertionPoint


This should correct your problem.
I'm not sure why, but I've had a similar problem with using VBA to place text into drawings.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Replacing Att Def's with text.
« Reply #3 on: April 13, 2004, 08:18:53 AM »
Ok, the problem is one that many people tend to overlook. Whenever you insert text with VBA and use the alignment point, you should be transferring both of the alignment points.

If a text item is defined as anything other than left justified, Autodesk saw fit to use a different DXF code to implement that point. Problem is, that whenever you initially define a bit of text if the initial alignment point is anything bet left, the point referenced by InsertionPoint is always 0,0,0 and whenever you insert text that is left justified, the point referenced by TextAlignmentPoint is always 0,0,0 So......

Code: [Select]

           For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.TextAlignmentPoint = AT.TextAlignmentPoint
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next


So this should fix that problem...

Just remember that if you apply the alignment point BEFORE you apply the alignment, the text will sometimes do wierd things...
So apply the alignment first then apply the alignment point.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

TR

  • Guest
Replacing Att Def's with text.
« Reply #4 on: April 13, 2004, 08:27:20 PM »
Thanks guys.

I added the TextAlignmentPoint stuff and now it's not moving all the items but it's skipping some of the attribute definitions. I'll have to take a look at a little closer when I get some free time.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Replacing Att Def's with text.
« Reply #5 on: April 13, 2004, 08:53:13 PM »
Turn off the error checking the next time you run it and see if it is a coding error.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

daron

  • Guest
Replacing Att Def's with text.
« Reply #6 on: April 14, 2004, 09:56:23 PM »
I was working on a lisp of this once and Stig helped (gave) me with a solution. Let me go see if I can find it.

daron

  • Guest
Replacing Att Def's with text.
« Reply #7 on: April 14, 2004, 10:01:55 PM »
How's this?

TR

  • Guest
Replacing Att Def's with text.
« Reply #8 on: April 15, 2004, 02:15:48 AM »
Thanks Daron.....but I want to do it in vba. I don't really know visual-lisp and I'm not about to start learning it now. :)

daron

  • Guest
Replacing Att Def's with text.
« Reply #9 on: April 15, 2004, 07:59:36 AM »
That's too bad. That's one fast routine. You're welcome.

hendie

  • Guest
Replacing Att Def's with text.
« Reply #10 on: April 15, 2004, 08:37:43 AM »
the code ran fine for me when I substituted Keiths code regarding alignment

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Replacing Att Def's with text.
« Reply #11 on: April 15, 2004, 09:55:44 AM »
Hendie, I think that would appear to be the fix
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

TR

  • Guest
Replacing Att Def's with text.
« Reply #12 on: April 15, 2004, 06:39:26 PM »
It seems I was getting a weird error message. I looked it up online and it doesn't really mean anything. I did a select case to check if it for that error message and resume next if it was. I'll post the code when I get to work tomorrow in case anyone wants it for anything.

Thanks for the help guys.

TR

  • Guest
Replacing Att Def's with text.
« Reply #13 on: April 16, 2004, 06:32:22 PM »
Here's the fixed code if anyone's interested.
Code: [Select]

Option Explicit
Public Sub remove_attdef()

    Dim SelSet As AcadSelectionSet
    Dim AT As AcadAttribute
    Dim FilterType(0 To 0) As Integer
    Dim FilterData(0 To 0) As Variant
    Dim TXT As AcadText
    Dim YesNo

    'select attribute definitions
    FilterType(0) = 0
    FilterData(0) = "ATTDEF"

    On Error GoTo Exit_Error
    ThisDrawing.SelectionSets.Add "SelSet"
    Set SelSet = ThisDrawing.SelectionSets("SelSet")
    SelSet.Clear

    SelSet.Select acSelectionSetAll, , , FilterType, FilterData

    'if the count is greater than 1 then there are attribute definitions in
modelspace
    If SelSet.Count <> 0 Then
        YesNo = MsgBox("You Have " & SelSet.Count & " Attribute
Definition(s) in " & ThisDrawing.Name & _
        ". Would you like this program to attempt to convert them to text?",
_
        vbYesNo + vbCritical + vbDefaultButton1)
        'if "Ok" is pressed then try to replace all of the attribute
definitions with text that has the same properties.
        If YesNo = vbYes Then
            For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.TextAlignmentPoint = AT.TextAlignmentPoint
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next
        End If
    End If
    'clear the selection set
    SelSet.Clear
    'rescan the drawing for attribute definitions
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if it the count is zero then it worked.
    If SelSet.Count = 0 Then
        MsgBox "All attributes were converted to text."
    Else:
        MsgBox "Failed to convert all attributes to text."
    End If

Exit_Error:
    Select Case Err.Number
    Case -2145386494 'not applicable
        Resume Next
    Case Else
        SelSet.Delete
        Set SelSet = Nothing
        Set AT = Nothing
        Set TXT = Nothing
    End Select
End Sub

hendie

  • Guest
Replacing Att Def's with text.
« Reply #14 on: April 20, 2004, 03:55:45 AM »
funny how things work out.

I just found a use for this routine. Thanks guys.