Topic: Scaling a list of blocks from a know point

[Bmossman]

I've got this simple code that I've have for years that scales down objects based on selecting them on the screen. I don't know lisp at all so bare with me.

I know this is probably easy, but here's what I'm trying to do:

- Select blocks from a list, say Block1, Block2, Block3
- Then I want to scale those blocks in the list from a known base point of say 0,0

What do I need to incorporate in the following code to accomplish this? Thanks in advance!

Code: [Select]

(defun C:24x36 (/ so ba)
(prompt "\nSelect Objects To Scale : ")
(setq so (ssget))
(initget 1)
(setq ba (getpoint "\nLocate base point: "))
(command ".scale" so "" ba "r" "1" "1.06382978723")
(princ)
)

[Lee Mac]

Assuming I've correctly understood, try the following code:

Code: [Select]

(defun c:scaleblocks ( / bpt def fac idx lst obj sel )

    (setq bpt '(0.0 0.0 0.0) ;; Base point
          fac 1.06382978723  ;; Scale factor
    )
   
    (while (setq def (tblnext "block" (not def)))
        (if (zerop (logand 5 (cdr (assoc 70 def))))
            (setq lst (cons (cdr (assoc 2 def)) lst))
        )
    )
    (cond
        (   (null lst)
            (princ "\nNo blocks found in the active drawing.")
        )
        (   (null (setq lst (LM:listbox "Select Blocks to be Scaled" (acad_strlsort lst) 1)))
            (princ "\n*Cancel*")
        )
        (   (null (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>"))))))
            (princ "\nNo references found for the selected blocks.")
        )
        (   (repeat (setq idx (sslength sel))
                (if (vlax-write-enabled-p (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))
                    (vlax-invoke obj 'scaleentity bpt fac)
                )
            )
        )
    )
    (princ)
)

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)

(vl-load-com) (princ)
The above uses my List Box function.

[Bmossman]

Thanks for the reply Lee. I want to be able to define the block names in the routine, say block1, block2, block3, and have the routine select those blocks and scale based on the scale factor and base point defined in the routine. Thanks for your help!

Assuming I've correctly understood, try the following code:

Code: [Select]

(defun c:scaleblocks ( / bpt def fac idx lst obj sel )

    (setq bpt '(0.0 0.0 0.0) ;; Base point
          fac 1.06382978723  ;; Scale factor
    )
   
    (while (setq def (tblnext "block" (not def)))
        (if (zerop (logand 5 (cdr (assoc 70 def))))
            (setq lst (cons (cdr (assoc 2 def)) lst))
        )
    )
    (cond
        (   (null lst)
            (princ "\nNo blocks found in the active drawing.")
        )
        (   (null (setq lst (LM:listbox "Select Blocks to be Scaled" (acad_strlsort lst) 1)))
            (princ "\n*Cancel*")
        )
        (   (null (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>"))))))
            (princ "\nNo references found for the selected blocks.")
        )
        (   (repeat (setq idx (sslength sel))
                (if (vlax-write-enabled-p (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))
                    (vlax-invoke obj 'scaleentity bpt fac)
                )
            )
        )
    )
    (princ)
)

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)

(vl-load-com) (princ)
The above uses my List Box function.

[Lee Mac]

I want to be able to define the block names in the routine, say block1, block2, block3, and have the routine select those blocks and scale based on the scale factor and base point defined in the routine.

This revelation contrary to your original post makes the program far simpler... e.g.:

Code: [Select]

(defun c:scaleblocks ( / bpt fac idx lst obj sel )
    (setq
        bpt '(0.0 0.0 0.0) ;; Base point
        fac 1.06382978723  ;; Scale factor
        lst
       '(
            "Block1"
            "Block2"
            "Block3"
        )
        lst (mapcar 'strcase lst)
    )
    (if (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR") (2 . "`*U*")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>")))))
        (repeat (setq idx (sslength sel))
            (if (and (member (strcase (vla-get-effectivename (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))) lst)
                     (vlax-write-enabled-p obj)
                )
                (vlax-invoke obj 'scaleentity bpt fac)
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)
Perhaps others may benefit from the earlier post so that my time hasn't been in vain.

[Bmossman]

Thanks Lee! Works to Perfection. I can also use the original one as well!

Thanks Again!
BRian

I want to be able to define the block names in the routine, say block1, block2, block3, and have the routine select those blocks and scale based on the scale factor and base point defined in the routine.

This revelation contrary to your original post makes the program far simpler... e.g.:

Code: [Select]

(defun c:scaleblocks ( / bpt fac idx lst obj sel )
    (setq
        bpt '(0.0 0.0 0.0) ;; Base point
        fac 1.06382978723  ;; Scale factor
        lst
       '(
            "Block1"
            "Block2"
            "Block3"
        )
        lst (mapcar 'strcase lst)
    )
    (if (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR") (2 . "`*U*")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>")))))
        (repeat (setq idx (sslength sel))
            (if (and (member (strcase (vla-get-effectivename (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))) lst)
                     (vlax-write-enabled-p obj)
                )
                (vlax-invoke obj 'scaleentity bpt fac)
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)
Perhaps others may benefit from the earlier post so that my time hasn't been in vain.

[BIGAL]

A command line variation so that you do not have to hard code the block names. Note the block names must be typed case correct.

(c:scaleblocks (list  "Block1" "Block2" "Block3"))

Code: [Select]

(defun c:scaleblocks (lst / bpt fac idx obj sel )
    (setq
        bpt '(0.0 0.0 0.0) ;; Base point
        fac 1.06382978723  ;; Scale factor
       
    )
    (if (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR") (2 . "`*U*")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>")))))
        (repeat (setq idx (sslength sel))
            (if (and (member (strcase (vla-get-effectivename (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))) lst)
                     (vlax-write-enabled-p obj)
                )
                (vlax-invoke obj 'scaleentity bpt fac)
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)


[ronjonp]

A command line variation so that you do not have to hard code the block names. Note the block names must be typed case correct.

(c:scaleblocks (list  "Block1" "Block2" "Block3"))

Code: [Select]

(defun c:scaleblocks (lst / bpt fac idx obj sel )
    (setq
        bpt '(0.0 0.0 0.0) ;; Base point
        fac 1.06382978723  ;; Scale factor
       
    )
    (if (setq sel (ssget "_X" (append '((0 . "INSERT") (-4 . "<OR") (2 . "`*U*")) (mapcar '(lambda ( n ) (cons 2 n)) lst) '((-4 . "OR>")))))
        (repeat (setq idx (sslength sel))
            (if (and (member (strcase (vla-get-effectivename (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))))) lst)
                     (vlax-write-enabled-p obj)
                )
                (vlax-invoke obj 'scaleentity bpt fac)
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)


Don't forget this part: (mapcar 'strcase lst) .. otherwise the member check is case sensitive.