Writing Macros??

[dtessier]

I am relatively new in writing macros in AutoCAD, but do have experience with VBA in Excel. I am needing to alter a large number of drawings in the following way:

1) Change all font in the drawing to a different font style
ie. Before: test, After: test

2) All font that is aligned vertically to be aligned horizontally
ie. Before: t After: test
e
s
t

3)Delete all blocks in the drawing, and also in the block library.

4)Delete drawing borders.

Would anyone know of any macros that might do this or something similiar to this, that I might be able to alter. I would normally do this by hand, but since there are a large number of drawings that I must do this for, I would prefer to do it with a macro. Thank you in advance for your time and consideration.

Dustin[/b]

 

[TCARPENTER]

Hi Dustin,

This isn't the most efficient code but it'll get you about 90% there:

  Dim objEnt As AcadEntity
  Dim objBlkRef As AcadBlockReference
  Dim objText As AcadText
  
  For Each objEnt In ThisDrawing.ModelSpace
    If objEnt = "AcDbBlockReference" Then
      objEnt.Delete
    End If
    
    If objEnt = "AcDbText" Then
      objText.StyleName = "MyStyleName"
    End If
  Next objEnt
  
  ThisDrawing.PurgeAll

The problem with what you want to do is, I don't see anywhere how to control the Vertical alignment of the text. So one option, create a style called "MyStyleName" with the style dialog box and then apply that style to the text you find.

Maybe some of the LISP gurus here can tell you how to it with lisp or just plug in a lisp command using the ThisDrawing.Sendcommand syntax to call it from VBA?

HTH
Todd

 

[dtessier]

I am getting a run time error 438, "object doesn't support this property or method..." on the first IF statement. What do you suggest?

 

[TCARPENTER]

Oops,

Try this:

Dim objEnt As AcadEntity
  Dim objBlkRef As AcadBlockReference
  Dim objText As AcadText
  
  For Each objEnt In ThisDrawing.ModelSpace
    If objEnt.[red]ObjectName[/red] = "AcDbBlockReference" Then
      objEnt.Delete
    End If
    
    If objEnt = "AcDbText" Then
      objText.StyleName = "MyStyleName"
    End If
  Next objEnt
  
  ThisDrawing.PurgeAll

HTH
Todd