a lisp to apply 3 different lisp to 3 obj types filtered from one selection

[alanjt]

So, I guess I kind of understand how to make a subroutine... but still can´t do it by myself... I am not in a hurry with this.... so I will wait for heaven to light you on again, hopefully you'll find some more time later and we can keep this post going on...

Steps left to finish:

- Changing Bu.lsp to subrutine to apply to filtered blocks..
- Finding the way to apply current dim settings to filtered dims and leaders from selection...

-Get all in shape to work together without prompt.

1. I still don't know what BU.lsp is.
2. So you want to be able to dim update dimensions?

Here's an example of a routine and a subroutine:

Routine to just select some objects and change the color to green

(defun c:ChangeColor ( / ss)
  (and (setq ss (ssget "_:L"))
       (command "_.change" ss "" "_p" "_co" 3 ""))
  (princ))

Subroutine that, when fed a selection set, will change the color to green.

(defun ChangeColor (ss)
  (and ss (command "_.change" ss "" "_p" "_co" 3 "")))

(setq s (ssget))
(ChangeColor s)

[gilsoto13]

1. I still don't know what BU.lsp is.
2. So you want to be able to dim update dimensions?

Here's an example of a routine and a subroutine:

Routine to just select some objects and change the color to green

(defun c:ChangeColor ( / ss)
  (and (setq ss (ssget "_:L"))
       (command "_.change" ss "" "_p" "_co" 3 ""))
  (princ))

Subroutine that, when fed a selection set, will change the color to green.

(defun ChangeColor (ss)
  (and ss (command "_.change" ss "" "_p" "_co" 3 "")))

(setq s (ssget))
(ChangeColor s)

Well, Bu.lsp is the lisp made by Lee Mac... I attached it in page 2 in this thread, mmm... It just "updates" selected blocks, changing their scale to current Dimscale value, it also synchronizes them after changing their scale, using attsync. This is the lisp I am trying to use it for the selection of blocks. The question will be how to convert it in a subroutine... It seems easy.. I can even try it right now, the problem is that I am at work right now, and my boss is walking aroung behind me and I am suppose to be working in a drawing for a Mine project instead of typing and analizing codes :S.... jajaja... but I must confess this is more exciting than drafting 'cause of automation and improvement in drafting methods...

And yep, still want to update dims and leaders too, Would it be possible using

(vl-cmdf "dimupdate" #ss)

Somehow...?

[gilsoto13]

1. I still don't know what BU.lsp is.
2. So you want to be able to dim update dimensions?

Here's an example of a routine and a subroutine:

Routine to just select some objects and change the color to green

(defun c:ChangeColor ( / ss)
  (and (setq ss (ssget "_:L"))
       (command "_.change" ss "" "_p" "_co" 3 ""))
  (princ))

Subroutine that, when fed a selection set, will change the color to green.

(defun ChangeColor (ss)
  (and ss (command "_.change" ss "" "_p" "_co" 3 "")))

(setq s (ssget))
(ChangeColor s)

Alan... I was wondering.... I wanted to fix text and mtext to width=0.8... 'cause it's a company standard also... so I found two possible ways... one of them I think is possible using this lisp,

http://forums.augi.com/showthread.php?t=53180

Do you think you can modify it to work as subroutine to update text and mtext to current style, text heigth and width=0.8

 
(defun c:StpMtext (/ ss ent1 ent2 tstr1 tstr2)
; Strips Mtext of certain formating

(command "_.undo" "_end")
(command "_.undo" "_group")
(if (setq ss (ssget '((0 . "MTEXT"))))
(while (/= (sslength ss) 0)
  (setq ent1 (ssname ss 0))
  (setq ent2 (vlax-ename->vla-object ent1))
  (setq tstr1 (vlax-get ent2 'TextString))
  (setq tstr2 (StripString tstr1))
  (vlax-put ent2 'TextString tstr2)
  (ssdel ent1 ss)
); while
); if
(command "_.undo" "_end")
(princ)
)

;-------------------------------------

(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

(setq cnt1 1)
(while (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
(if (= cstr1 "\\")
  (progn
   (setq cstr2 (substr String 2 1))
   (if (member (strcase cstr2) '("C" "F" "H" "W"))
    (progn
     (while (/= (substr String cnt1 1) ";")
      (setq cnt1 (1+ cnt1))
     ); while
     (setq String (substr String (1+ cnt1) (strlen String)))
     (setq cnt1 1)
    ); progn
    (progn
     (if nString
      (setq nString (strcat nString (substr String 1 1)))
      (setq nString (substr String 1 1))
     ); if
     (setq String (substr String 2 (strlen String)))
    ); progn
   ); if
  ); progn
  (progn
   (if nString
    (setq nString (strcat nString (substr String 1 1)))
    (setq nString (substr String 1 1))
   ); if
   (setq String (substr String 2 (strlen String)))
  ); progn
); if
); while
(setq tstr1 (vl-string->list nString))
(if (and (not (member 92 tstr1)) (member 123 tstr1))
(setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
); if
(vl-list->string tstr1)
)

[alanjt]

(vla-put-TextString x (StripString (vla-get-TextString x)))

[gilsoto13]

ooooh, Com'onnn

I am getting very frustated with vla... I definitively like normal lisp...

I went into multiple pages to try to figure out how to just update selected dimensions to current Dimstyle via vla, I found we can use the dimstyle variable string... but didn´t work, I found the vla-update, used in some lisps to update selected dimensions to a defined dimstyle... but couldn´t make it work either, I tried several ways and just can´t add this part to the lisp.

http://www.vizikos.com/lisp/dimse.lsp

Can you make it work with something involving vla-update or "Dimstyle" variable (current) to update the leaders and dimensions selection?

;; dimension, leader
; ((wcmatch (vla-get-objectname x) "AcDbDimension" "AcDbLeader")
; (vl-catch-all-apply 'vla-update x (getvar 'Dimstyle))
; )
; ((wcmatch (vla-get-objectname x) "" X)
; (vla-update x (getvar 'dimstyle))
; (vl-catch-all-apply 'vla-update (list x "Metr_100"))
; (vla-update x)
; (vla-put-ActiveDimStyle x (getvar 'dimstyle))

[gilsoto13]

I made it, at least for text and dimensions, and leaders

I just added this before the end... and works...

 
(command "_.-dimstyle" "_apply" "p" "")
) ;_ defun

by I cannot merge a whole lisp inside to apply to blocks...
this is the lisp I want to use for blocks..
I tried some ways but no one worked.. it seems I need to merge the whole code somehow, deleting some lines and adding some others at the beginning... but still after merging this.. I need to re-filter the blocks with a list...
and also... apply the width=.8 to text and mtext...

Still much work to do... I needed 4 hours to figure out the dim update thing...

I think I'll just leave this project there...

 
;Update selected blocks to current Dimscale, supports Normal, attributed and dynamic blocks
;by Lee Mac from Cadtutor
(defun c:bu (/ *error* doc oldc ss sel scl)
  (vl-load-com)
 
  (defun *error* (msg)
    (if doc (vla-EndUndoMark doc))
    (if oldc (setvar "CMDECHO" oldc))
    (if (not
          (wcmatch
            (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n** Error: " msg " **")))
    (princ))
 
  (setq doc (vla-get-ActiveDocument
              (vlax-get-acad-object)))
  (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
  (setvar "CMDECHO" 0)
  (prompt "\nSelect Blocks to match current dimscale... ")
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (vla-StartUndoMark doc)
      (command "_.-objectscale" ss "" "_add" "1:1" "")
      (setvar "CANNOSCALE" "1:1")
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))        
        (foreach x
          (if (eq :vlax-true
                (vla-get-IsDynamicBlock Obj))
            '(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
            '(XScaleFactor YScaleFactor ZScaleFactor))
          (vlax-put-property Obj x scl))
        (if (eq :vlax-true (vla-get-HasAttributes Obj))
          (command "_.attsync" "_Name"
            (vlax-get-property Obj
              (if (eq :vlax-true
                    (vla-get-isDynamicBlock Obj)) 'EffectiveName 'Name)))))
      (vla-delete sel)
      (vla-EndUndoMark doc)))
 
  (setvar "CMDECHO" oldc)
  (princ))

[gilsoto13]

1. I still don't know what BU.lsp is.
2. So you want to be able to dim update dimensions?

Here's an example of a routine and a subroutine:

Routine to just select some objects and change the color to green

(defun c:ChangeColor ( / ss)
  (and (setq ss (ssget "_:L"))
       (command "_.change" ss "" "_p" "_co" 3 ""))
  (princ))

Subroutine that, when fed a selection set, will change the color to green.

(defun ChangeColor (ss)
  (and ss (command "_.change" ss "" "_p" "_co" 3 "")))

(setq s (ssget))
(ChangeColor s)

All right... here is all what I was trying to do in one lisp it has some little bugs... but the thing I would like to start fixing is the objective of this post... to split the initial selection into 2 selections, Right now I need to select the detail twice, first selection is for mtext, text, dims and leaders editing process and then I need to select the detail again for blocks.

Can anybody help to select only once, and then the lisp could use that selection for all the objects to be used in their particular processes?

;Detail updater (Du.lsp)
;It will update a complete detail, updating mtext, text to current textsize value, and width=0.8,
;It will update dimensions and leaders to current dims settings (dimscale)
;It will also grab only M3 standard blocks from selection and update their scale to current dimscale
(defun c:du (/ *error* doc oldc ss sel scl)
  (vl-load-com)
   (defun *error* (msg)
    (if doc (vla-EndUndoMark doc))
    (if oldc (setvar "CMDECHO" oldc))
    (if (not
          (wcmatch
            (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n** Error: " msg " **")))
    (princ))
 
  (setq doc (vla-get-ActiveDocument
              (vlax-get-acad-object)))
  (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
  (setvar "CMDECHO" 0)
(princ " Select text, dimension, leaders to update:") 
(princ " ") 
(setq s_set (ssget '( (-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (0 . "DIMENSION") (0 . "LEADER") (-4 . "OR>") )));
  (prompt "\nSelect Blocks to match current dimscale... ")
  (if (setq ss (ssget '((0 . "INSERT")(2 . "AFC  Spanish,AFC,AFCnfc,As Built,Asbuilt Spanish,Asterisk,Bluestake stick,Break line,Break,Center line,Center line2,Column row bubble,Column row bubble2,Detail Bubble 1,Detail Bubble 12,Detail bubble,Detail bubble2,Directional arrow,DTESTAMP,Dust pick up point,Dust pick up point2,DYNAMIC WELD SYMBOL,Equipment Tag1,Equipment Tag2,Flow arrow,Full section LR,Full Section LR2,Full section UD,Full section UD2,Full section,Full section2,GST026,GWE001,GWE001old,GWE002,GWE003,GWE004,GWE005,GWE006,GWE007,GWE008,GWE009,GWE010,GWE011,GWE012,GWE013,GWE014,GWE015,GWE016,GWE017,GWE018,GWE019,GWE020,HP36NOD,Issued for construction,Issued for Design,Issued for Feasibility Study Sticker,M3BOR,m3logo,Match line sp,Match line sp2,Match line,Match line2,ML,North arrow,North arrow2,Note box,Note box2,Note encl,Note encl2,nut 0.75,nut 1,Off sheet reference,Partial section t,Partial section t2,Partial section,Partial section2,Plate,Plate2,Preliminary Spanish,Preliminary,Reference,Revision,Revision2,Sample number,Sample number2,Section Cut UD,Section Cut UD2,Section Cut,Section Cut2,Section Marker,Stamp Big,Stamp Big2,Stamp Small,Stamp Small2,Stream number,Stream number2,Stream sequence,Stream sequence2,Tag,Tag2,Title 1,Title 12,Title bubble 1,Title bubble 12,Title bubble,Title bubble2,Title,Title2,Work point,Work point2,Worker1,Worker2,Worker3,Worker4,Worker5,Worker6,Worker7,Worker8"))))
    (progn
      (vla-StartUndoMark doc)
      (command "_.-objectscale" ss "" "_add" "1:1" "")
      (setvar "CANNOSCALE" "1:1")
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))        
        (foreach x
          (if (eq :vlax-true
                (vla-get-IsDynamicBlock Obj))
            '(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
            '(XScaleFactor YScaleFactor ZScaleFactor))
          (vlax-put-property Obj x scl))
        (if (eq :vlax-true (vla-get-HasAttributes Obj))
          (command "_.attsync" "_Name"
            (vlax-get-property Obj
              (if (eq :vlax-true
                    (vla-get-isDynamicBlock Obj)) 'EffectiveName 'Name)))))
      (vla-delete sel)
      (vla-EndUndoMark doc)))
 
  (setvar "CMDECHO" oldc)
  (princ)
(setq new_heigth (getvar 'textsize)) ;
;Entity DXF List Information & Manipulation... 
(setq index_1 0) 
 (while 
  (< index_1 (sslength s_set)) 
 (setq e1_list (entget (ssname s_set index_1))) 
 (setq heigth (cdr (assoc 40 e1_list))) 
 (setq width (cdr (assoc 41 e1_list))) 
 (setq e1_list (subst (cons 40 new_heigth) (assoc 40 e1_list) e1_list )) 
 (setq e1_list (subst (cons 41 0.8) (assoc 41 e1_list) e1_list )) 
 (entmod e1_list) 
 (setq index_1 (+ index_1 1)
) 
) 
 (command "_.-dimstyle" "_apply" s_set "")
 (command "redraw") 
)

[gilsoto13]

Marco Jacinto, a great pal from Puerto Vallarta, Mexico.. finally gave this a happy ending, made my day and I appreciate your help too, Alan.

This is the final code. This lisp updates a whole detail according to current Dimscale value. It resizes text, mtext, dimensions, leaders and standard blocks (filtered with a list from the selection set), It also updates standard attributed, dynamic, normal and annotative blocks, all in once.
Also, it turns mtext and text width to 0.8 according to our standards.

(vl-load-com) 
;Detail Update Du.lsp
;Codigo original por Lee Mc Donell de Cadtutor 
;Codigo modificado por Marco Jacinto, para en una misma seleccion 
;cambiar los textos, Mtextos, bloques y dimensiones. 
;Se comento el codigo original, en donde el codigo es reduntante, y se 
;cambio para utilizar solo funciones ActiveX. 
;Marco Jacinto Puerto Vallarta Mexico Noviembre 2009  
;Post Original en HispaCAD  
;http://www.hispacad.com/foro/viewtopic.php?t=25876&highlight=  
; |; 
(defun c:DU (/ DOC NEW_HEIGTH OLDERR ONAME SC SCL SEL S_SET NomBloques) 
 
  (setq olderr *error*) 
  (defun *error* (msg) 
    (if    (= 8 (logand (getvar "undoctl") 8)) 
      (vla-EndUndoMark doc) 
    ) 
    (if    (not 
      (wcmatch 
        (strcase msg) 
        "*BREAK,*CANCEL*,*EXIT*" 
      ) 
    ) 
      (princ (strcat "\n** Error: " msg " **")) 
    ) 
    (setq *error* olderr) 
    (princ) 
  ) 
  (setq    doc (vla-get-ActiveDocument 
          (vlax-get-acad-object) 
        ) 
  ) 
  (setq    scl       (getvar "DIMSCALE") 
  ) 
  (setq 
    BkLst 
           '("AFC*"              "*BUILT*"           "ASTERISK" 
         "BLUESTAKE STICK"    "BREAK LINE"       "BREAK" 
         "CENTER LINE*"          "COLUMN ROW BUBBLE*" "COLUMN ROW BUBBLE2" 
         "DETAIL BUBBLE*"     "DIRECTIONAL ARROW"  "DTESTAMP" 
         "DUST PICK UP POINT" "DUST PICK UP POINT2" 
         "DYNAMIC WELD SYMBOL"               "EQUIPMENT TAG1" 
         "EQUIPMENT TAG2"     "FLOW ARROW"       "FULL SECTION LR" 
         "FULL SECTION LR2"   "FULL SECTION UD"       "FULL SECTION UD2" 
         "FULL SECTION"          "FULL SECTION2"       "GST026" 
         "GWE*"              "HP36NOD"           "ISSUED FOR*" 
         "M3BOR"          "M3LOGO"           "MATCH LINE*" 
         "ML"              "NORTH ARROW*"       "NOTE BOX" 
         "NOTE BOX*"          "NOTE ENCL*"       "NUT*" 
         "OFF SHEET REFERENCE"               "PARTIAL SECTION*" 
         "PLATE"          "PLATE*"           "PRELIMINARY*" 
         "REFERENCE"          "REVISION*"       "SAMPLE NUMBER*" 
         "SECTION CUT UD*"    "SECTION CUT*"       "SECTION MARKER" 
         "STAMP *"          "STREAM*"           "TAG*" 
         "TITLE*"          "TITLE BUBBLE*"       "TITLE*" 
         "WORK POINT*"          "WORKER*"           "GST*" 
        ) 
    NomBloques (car BkLst) 
    BkName     (mapcar '(lambda    (x) 
              (setq NomBloques (strcat NomBloques "," x)) 
            ) 
               (cdr BkLst) 
           ) 
  ) 
 
  (princ "\n Selecciona los objetos a escalar :") 
  (if (setq s_set (ssget (list '(-4 . "<OR") 
                   '(0 . "TEXT") 
                   '(0 . "MTEXT") 
                   '(0 . "DIMENSION") 
                   '(0 . "LEADER") 
                    ; _Se seleccionan todos los bloques de 
                    ; usuario, despues se procesaran los 
                    ; nombres esto para poder procesar los 
                    ; bloques dinamicos 
                   '(-4 . "<AND") 
                   '(0 . "INSERT") 
                   (cons 2 (strcat NomBloques ",`*U*")) 
                   '(-4 . "AND>") 
                   '(-4 . "OR>") 
             ) 
          ) 
      ) 
    (progn 
      (vla-StartUndoMark doc) 
      (setq new_heigth (* (getvar 'DimScale)0.125)) 
;_ Mcoan Verificamos cada objeto en la seleccion para procesarlo 
      (vlax-for    Obj (setq sel (vla-get-ActiveSelectionSet doc)) 
    (cond 
      ((and 
         (=    (setq Oname (vla-get-Objectname Obj)) 
        "AcDbBlockReference" 
         ) 
         (wcmatch (strcase (vla-get-EffectiveName Obj)) NomBloques) 
       ) 
       ;;;Para evitar problemas al escalar bloques con atributos, mejor 
       ;;;escalamos los bloques con un metodo para el objeto y no  
       ;;;con la propiedad de escala del bloque. 
       (setq sc (/ 1 (/ (vla-get-XScaleFactor Obj) scl))) 
       ;;;Se usa el factor de escala del bloque sin signo, para evitar 
       ;;;errores al escalar un objeto con escala negativa 
       (vla-ScaleEntity obj (vla-get-InsertionPoint Obj) (abs sc)) 
      ) 
      ((wcmatch Oname "AcDbMText,AcDbText") 
       (vla-put-Height Obj new_heigth) 
       ;;;La propiedad ScaleFactor no esta presente en Mtextos 
       (if (vlax-property-available-p obj 'ScaleFactor) 
         (vla-put-ScaleFactor Obj 0.80) 
       ) 
      ) 
      ((wcmatch (strcase Oname) "*LEADER,*DIM*") 
        (vl-catch-all-apply 'vla-put-ScaleFactor (list Obj scl)) 
      ) 
    ) 
      ) 
      (vla-delete sel) 
      (vla-EndUndoMark doc) 
    ) 
  ) 
  (princ) 
) 
 ;|«Visual LISP© Format Options» 
(80 2 40 2 nil "end of " 60 9 0 0 0 T T T T) 
;*** DO NOT add text below the comment! ***|;

[alanjt]

Marco Jacinto, a great pal from Puerto Vallarta, Mexico.. finally gave this a happy ending, made my day and I appreciate your help too, Alan.

This is the final code. This lisp updates a whole detail according to current Dimscale value. It resizes text, mtext, dimensions, leaders and standard blocks (filtered with a list from the selection set), It also updates standard attributed, dynamic, normal and annotative blocks, all in once.
Also, it turns mtext and text width to 0.8 according to our standards.

Glad you finally got this sorted out.
On to the next project.