Jump to content

Change attribute textstyle within block


Corro

Recommended Posts

Hi All

 

I am trying to create a lisp routine to change the attribute textstyle within a block and there are a multiple of different blocks to be changed within the same drawing.

This is also to be applied to many drawings to bring them into line with the updated CAD standards.

Attached is current program, but I am having trouble associating variables for the fist part, BLOCKS, as I need the current text style and text height to then be able to define the new values.

I an been able to convert the ActiveX name to a lisp name and set variable "nam", but I am unable to extract any text variables from this "block" object.

The lower section, attribute definition, seems to work.

I have also attached a small sample of the block. If you double click the block and check the text options, the text style is TXT-35 (TXT-18). If you explode the block, the text style is Romans, with different heights.

Any help appreciated.

Regards

Steve

Demo_CBS_1.lsp

Reference-1.dwg

Link to comment
Share on other sites

Ho Corro,

 

 

I have include a file with a routine a wrote last year. It's not very well documented and all , but maybe there is something in there you can use.

 

 

The question was if I could write an app that was able to change the text style for a list with specific block names. Maybe its usefull , maybe it's not...

 

 

gr. Rlx

vth.LSP

Link to comment
Share on other sites

Hi All

I now have a timeframe to have this List routine finished.

Attached is what I have so for, but I need to be able to determine the current TextStyle of the attributes and then compare them to be able to set the replacement TextStyle.

I have also attached a sample of one of the blocks which has both attributes and Attribute Definitions, and I need to change the textstyle of both.

Also attached is how I envisage comparing the current textstyle to new style.

Any help appreciated.

Thanks

Demo_CBS.lsp

Reference-1.dwg

Sample Condition Statement.txt

Link to comment
Share on other sites

@ Corro:

Try the code below.

Note: Some text styles used by the att. refs do not match those used by the att. defs. The code does not solve that issue.

(vl-load-com)

; Return 1 or 0 (=fail).
(defun TextStyleChange (obj / hgt newStl stl)
 (setq hgt (vla-get-height obj))
 (setq stl (strcase (vla-get-stylename obj)))
 (if
   (and
     (setq newStl
       (cond
         ((wcmatch stl "TXT-##,TXT-#")
           (strcat (substr stl 5) "-TEXT")
         )
         ((= stl "ROMANS")
           (cond
             ((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
               "13-TEXT"
             )
             ((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
               "18-TEXT"
             )
             ((= hgt 250.0)
               "25-TEXT"
             )
             ((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
               "35-TEXT"
             )
             ((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
               "5-TEXT"
             )
             (T
               "7-TEXT"
             )
           )
         )
       )
     )
     (tblobjname "style" newStl)
   )
   (progn
     (vla-put-stylename obj newStl)
     1
   )
   (progn
     (princ (strcat "\nError: " newStl " not found "))
     0
   )
 )
)

(defun c:demo ( / doc i ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for blk (vla-get-blocks doc)
   (if (= :vlax-false (vla-get-isxref blk))
     (vlax-for obj blk
       (if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
         (TextStyleChange obj)
       )
     )
   )
 )
 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
       (TextStyleChange obj)
     )
   )
 )
 (vla-regen doc acallviewports)
 (princ)
)

Edited by Roy_043
Spelling...
Link to comment
Share on other sites

Hi Roy

Thank you for your response.

When run, it gives the error "bad argument type: stringp nil"

Variables "hgt", "newstl", "doc", and "obj" are all nil.

Any ideas?

Thanks

Link to comment
Share on other sites

The problem is caused by this line:

(princ (strcat "\nError: " newStl " not found "))

(strcat) will fail if newStl is nil.

 

Revised code:

(vl-load-com)

; Returns T or nil (=fail).
(defun TextStyleChange (obj / hgt newStl stl)
 (setq hgt (vla-get-height obj))
 (setq stl (strcase (vla-get-stylename obj)))
 (if
   (and
     (setq newStl
       (cond
         ((wcmatch stl "TXT-##,TXT-#")
           (strcat (substr stl 5) "-TEXT")
         )
         ((= stl "ROMANS")
           (cond
             ((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
               "13-TEXT"
             )
             ((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
               "18-TEXT"
             )
             ((= hgt 250.0)
               "25-TEXT"
             )
             ((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
               "35-TEXT"
             )
             ((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
               "5-TEXT"
             )
             (T
               "7-TEXT"
             )
           )
         )
       )
     )
     (or
       (tblobjname "style" newStl)
       (progn
         (princ (strcat "\nError: " newStl " not found "))
         nil
       )
     )
   )
   (progn
     (vla-put-stylename obj newStl)
     T
   )
 )
)

(defun c:demo ( / doc i ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for blk (vla-get-blocks doc)
   (if (= :vlax-false (vla-get-isxref blk))
     (vlax-for obj blk
       (if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
         (TextStyleChange obj)
       )
     )
   )
 )
 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
       (TextStyleChange obj)
     )
   )
 )
 (vla-regen doc acallviewports)
 (princ)
)

Link to comment
Share on other sites

Hi Roy

Works like a charm.

One other requirement has just been requested, if the current style exists eg 35-TEXT, but it has ROMANS font, the routine needs to change that to ARIAL font.

Are you to help?

Thanks again

Link to comment
Share on other sites

You may have to change the name of the .ttf file ("arial.ttf").

All #-TEXT and ##-TEXT styles are changed to Arial (I am not sure if that is what you want though).

(vl-load-com)

; Returns T or nil (=fail).
(defun TextStyleChange (obj / hgt newStl stl)
 (setq hgt (vla-get-height obj))
 (setq stl (strcase (vla-get-stylename obj)))
 (if
   (and
     (setq newStl
       (cond
         ((wcmatch stl "TXT-##,TXT-#")
           (strcat (substr stl 5) "-TEXT")
         )
         ((= stl "ROMANS")
           (cond
             ((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
               "13-TEXT"
             )
             ((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
               "18-TEXT"
             )
             ((= hgt 250.0)
               "25-TEXT"
             )
             ((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
               "35-TEXT"
             )
             ((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
               "5-TEXT"
             )
             (T
               "7-TEXT"
             )
           )
         )
       )
     )
     (or
       (tblobjname "style" newStl)
       (progn
         (princ (strcat "\nError: " newStl " not found "))
         nil
       )
     )
   )
   (progn
     (vla-put-stylename obj newStl)
     T
   )
 )
)

(defun FontChange (obj) ; Obj=text style object.
 (if (wcmatch (strcase (vla-get-name obj)) "##-TEXT,#-TEXT")
   (vla-put-fontfile obj "arial.ttf")
 )
)

(defun c:demo ( / doc i ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for obj (vla-get-textstyles doc)
   (FontChange obj)
 )
 (vlax-for blk (vla-get-blocks doc)
   (if (= :vlax-false (vla-get-isxref blk))
     (vlax-for obj blk
       (if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
         (TextStyleChange obj)
       )
     )
   )
 )
 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
       (TextStyleChange obj)
     )
   )
 )
 (vla-regen doc acallviewports)
 (princ)
)

Link to comment
Share on other sites

Hi Roy

Just noticed one problem in that both the 25-TEXT and 5-TEXT styles share some text heights.

This is why you removed the 250.0 from the 5-TEXT style, but the 25-TEXT style could also have a range of text heights, according the the scale of the drawing, which would conflict with the 5-TEXT style heights.

Is there a way to individualise the text heights to the style?

Thanks

Link to comment
Share on other sites

The current algorithm only looks at the existing style and text height.

The combination of "ROMANS" and 250.0 results in "25-TEXT" for the new style. If you you want the result to sometimes be "5-TEXT" you would have to look at an extra variable or property. Maybe the DIMSCALE variable can be used? Or the layer of the att. refs and defs?

 

The same problem may also occurs with "35-TEXT" and "7-TEXT".

 

BTW: IMO it would be more consistent to use "50-TEXT" and "70-TEXT" instead of "5-TEXT" and "7-TEXT" as new names.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...