LISP to modify linetype scale inside blocks

[hrehor]

I am looking for LISP routine that would change linetypescale of entities inside

all blocks in the drawing (or selected ones). I went through archive and google, and found lots of LISPs to modify layer, linetype, lineweight, but can't find anything particulary for linetypescale. (i really like behaviour of normblocks.lsp but it won't allow to change ltscale)

I would greatly appreciate any help since I have to deal with a drawing including thousands of blocks, and even bursting them freezes CPU.

[irneb]

Here's a "quick" hash:

(vl-load-com)
(defun c:SetLTScale (/ ss scale blk eo doc blocks bcol)
 (if (and (setq scale (getreal "New scale: "))
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
          (setq ss (ssget))
          (setq ss (vla-get-ActiveSelectionSet doc))
     )
   (progn
     (vlax-for eo ss
       (if (vlax-property-available-p eo 'LinetypeScale t)
         (vla-put-LinetypeScale eo scale)
       )
       (if (and (eq (vla-get-ObjectName eo) "AcDbBlockReference")
                (not (vl-position (vla-get-EffectiveName eo) blocks))
           )
         (setq blocks (cons (vla-get-EffectiveName eo) blocks))
       )
     )
     (setq bcol (vla-get-Blocks doc))
     (foreach blk blocks
       (vlax-for eo (vla-Item bcol blk)
         (if (vlax-property-available-p eo 'LinetypeScale t)
           (vla-put-LinetypeScale eo scale)
         )
       )
     )
   )
 )
 (princ)
)

[pBe]

or this, another "quick" hash

 

 
(defun FXB (new_lst / ELST ENAM ESEL BNAM FLST)
 (vl-load-com)
 (setq
   ESEL (entsel "\nSelect block: ")
   ENAM (car ESEL)
   ELST (entget ENAM)
   BNAM (cdr (assoc 2 ELST))
   FLST nil
   ) ;_ end of setq
 (fix1 BNAM)
 (vl-cmdf "regen")
 (prin1)
 ) ;_ end of defun
(defun
  FIX1 (BNAM / BENAM)
 (if (not (member BNAM FLST))
   (progn
     (setq
FLST  (cons BNAM FLST)
BENAM (tblobjname "block" BNAM)
) ;_ end of setq
     (while (setq BENAM (entnext BENAM))
(if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
  (fix1 (cdr (assoc 2 (entget BENAM))))
  (vla-put-linetypescale
    (vlax-ename->vla-object BENAM)
    new_lst
    ) ;_ end of vla-put-linetypescale
  ) ;_ end of if
) ;_ end of while
     ) ;_ end of progn
   ) ;_ end of if
 )

 

 

Usage: (fxb 5.0) :

BTW: single selection only for now but we can tweak it to mulitple selection

Edited January 5, 2011 by pBe
add notes

[David Bethel]

Or in plain Autolisp:

[b][color=BLACK]([/color][/b]defun c:ins-lts [b][color=FUCHSIA]([/color][/b]/ ns i ss en ed bn td xf fe ft fd bl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 7[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq ns [b][color=NAVY]([/color][/b]getdist [color=#2f4f4f]"\nNew LT Scale:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq i -1
           ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1+ i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   bn [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 2 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   td [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] bn[b][color=GREEN])[/color][/b]
                   xf [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 70 td[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   fe [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc -2 td[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]/= [b][color=RED]([/color][/b]logand xf 16[b][color=RED])[/color][/b] 16[b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]member bn bl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]progn
                    [b][color=BLUE]([/color][/b]entmake td[b][color=BLUE])[/color][/b]
                    [b][color=BLUE]([/color][/b]while fe
                      [b][color=RED]([/color][/b]setq fd [b][color=PURPLE]([/color][/b]entget fe[b][color=PURPLE])[/color][/b]
                            ft [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 0 fd[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b]if [b][color=PURPLE]([/color][/b]member ft '[b][color=TEAL]([/color][/b][color=#2f4f4f]"ARC"[/color] [color=#2f4f4f]"CIRCLE"[/color] [color=#2f4f4f]"LINE"[/color] [color=#2f4f4f]"LWPOLYLINE"[/color] [color=#2f4f4f]"POLYLINE"[/color][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                          [b][color=PURPLE]([/color][/b]if [b][color=TEAL]([/color][/b]assoc 48 fd[b][color=TEAL])[/color][/b]
                              [b][color=TEAL]([/color][/b]setq fd [b][color=OLIVE]([/color][/b]subst [b][color=GRAY]([/color][/b]cons 48 ns[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]assoc 48 fd[b][color=GRAY])[/color][/b] fd[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
                              [b][color=TEAL]([/color][/b]setq fd [b][color=OLIVE]([/color][/b]append fd [b][color=GRAY]([/color][/b]list [b][color=AQUA]([/color][/b]cons 48 ns[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b]entmake fd[b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b]setq fe [b][color=PURPLE]([/color][/b]entnext fe[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                    [b][color=BLUE]([/color][/b]entmake [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=PURPLE])[/color][/b][b][color=PURPLE]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                    [b][color=BLUE]([/color][/b]setq bl [b][color=RED]([/color][/b]cons bn bl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun c:ins-lts (/ ns i ss en ed bn td xf fe ft fd bl)
 (initget 7)
 (setq ns (getdist "\nNew LT Scale:   "))

 (and (setq i -1
           ss (ssget '((0 . "INSERT"))))
      (while (setq en (ssname ss (setq i (1+ i))))
             (setq ed (entget en)
                   bn (cdr (assoc 2 ed))
                   td (tblsearch "BLOCK" bn)
                   xf (cdr (assoc 70 td))
                   fe (cdr (assoc -2 td)))
             (if (and (/= (logand xf 16) 16)
                      (not (member bn bl)))
                 (progn
                    (entmake td)
                    (while fe
                      (setq fd (entget fe)
                            ft (cdr (assoc 0 fd)))
                      (if (member ft '("ARC" "CIRCLE" "LINE" "LWPOLYLINE" "POLYLINE"))
                          (if (assoc 48 fd)
                              (setq fd (subst (cons 48 ns) (assoc 48 fd) fd))
                              (setq fd (append fd (list [color=AQUA](cons 48 ns[color=AQUA]))))))
                      (entmake fd)
                      (setq fe (entnext fe)))
                    (entmake (list (cons 0 "ENDBLK")(cons 8 "0")))
                    (setq bl (cons bn bl))))))
 (prin1))

 

 

-David

[irneb]

David, just a query ... why do you recreate the block from scratch? Couldn't you just get hold of the internals using the -2 DXF code from the list returned by tblsearch. That should give you the ename of the 1st internal entity. Then using entnext to step through them all. And simply use an entmod instead of recreating all the stuff inside the block. The way you've got it, there may be quite a few things going haywire, like DB's failing, and I wouldn't touch anything with anno scales doing this.

 

Maybe I'm just missing something?

[David Bethel]

imed,

 

It's just an older way of redefining the block. I don't remember when the ability to use entmod on a table entity definition came into affect ( it hasn't always been so )

 

CECOLOR CELTYPE ELEVATION and THICKNESS would probably need to be set to their entmake defaults. As far as anno scales etc, the OP simply asked to set linetype scales. I limited the entities type to things they would normally display linetypes. Probably should exclude polyline meshes as well ( I didn't ) -David

[hrehor]

Great, great thanx irneb! thanx also to pBe and David, though I haven't tried your LISPs yet, since irneb's works perfectly.

 

I am always suprised and impressed with how easiness you write those programms.

Some time in future I need to sit and learn this stuff.

For now, thank you again,

regards

Hrehor

[3dwannab]

I can confirm the 1st example is the only one working for dynamic blocks.

 

Thank you David.