Topic: block x y independent scale dynamicly

[dussla]

hello freind
i have a problem

i have  some blocks
i would like to   change  x  y scale  independently

i know scale  command , 

but  i would like to scale  x y  with realtime   
is there good idea?

[Lee Mac]

How about using a dynamic block Linear Parameter associated with a Stretch Action, e.g.:

[dussla]

i  have to use entire block  stretch ,   block edit  modify 1 objects only
my work block is old block style ,   that is not dynamic block
so  i can't see  liner parameter in my work cad ( autocad2012)
~~

[Faster]

hello freind
i have a problem

i have  some blocks
i would like to   change  x  y scale  independently

i know scale  command , 

but  i would like to scale  x y  with realtime   
is there good idea?

Code: [Select]

(defun c:BlkDynScale  (/ BLKREF EL BASE LOOP GR W H W1 H1 obj)
  (if
    (and
      (setq blkref (car (entsel "\nSelect a insert :")))
      (= "INSERT" (cdr (assoc 0 (entget blkref))))
      )
     (progn
       (setq el   (entget blkref)
     base (trans (cdr (assoc 10 el)) 0 1))
       (sssetfirst nil (ssadd blkref))
       (vla-GetBoundingBox
(setq obj (vlax-ename->vla-object blkref))
'll
'ur)
       (mapcar
'set
(list 'w 'h)
(apply 'mapcar
(cons '- (mapcar 'vlax-safearray->list (list ur ll)))))
       (setq loop t xs (vla-get-XScaleFactor obj) ys (vla-get-YScaleFactor obj))
       (while loop
(setq gr (grread t 15))
(cond
   ((= 5 (car gr))
    (mapcar 'set
    (list 'w1 'h1)
    (mapcar '- (cadr gr) base))
    (setq xscale (* xs (/ w1 w))
  yscale (* ys (/ h1 h))
  )
    (redraw)
    (grdraw base (cadr gr) 7 1)
    (princ (strcat "\rXScle = " (rtos xscale 2 4) "  YScale = " (rtos yscale 2 4) "        "))
    (vla-put-XScaleFactor obj xscale)
    (vla-put-YScaleFactor obj yscale)
    (vla-update obj)

    )
   ((= 3 (car gr))
    (setq loop nil)
    (redraw)
    (sssetfirst  (ssadd blkref) nil)
    (mapcar 'set
    (list 'w1 'h1)
    (mapcar '- (cadr gr) base))
    (setq xscale (* xs (/ w1 w))
  yscale (* ys (/ h1 h))
  )
    (princ (strcat "\rXScle = " (rtos xscale 2 4) "  YScale = " (rtos yscale 2 4) "        "))
    (vla-put-XScaleFactor obj xscale)
    (vla-put-YScaleFactor obj yscale)
    (vla-update obj)
    )
   )
)
       )
     )
  (princ)
  )

[dussla]

good , thank you
but very  slow  ,  can you interval time ?

or   with getpoint

[Tharwat]

Try this piece of code .

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test (/ ss x y i sn dxfs)
2. ;;;;;=== Tharwat 24. Aug. 2012 ===;;;;;
3.   (if
4.     (and (setq ss (ssget "_:L" '((0 . "INSERT"))))
5.          (setq x (getdist "\n Specify X factor scale :"))
6.          (setq y (getdist "\n Specify Y factor scale :"))
7.     )
8.      (repeat (setq i (sslength ss))
9.        (setq sn (ssname ss (setq i (1- i))))
10.        (mapcar
11.          (function (lambda (x)
12.                      (if (member (car x) '(43 410 62 8 10 2 0))
13.                        (setq dxfs (cons x dxfs))
14.                      )
15.                    )
16.          )
17.          (entget sn)
18.        )
19.        (if (entmakex
20.              (append (reverse dxfs) (list (cons 41 x) (cons 42 y)))
21.            )
22.          (entdel sn)
23.        )
24.        (setq dxfs nil)
25.      )
26.   )
27.   (princ)
28. )
29.  
30.  

[mkweaver]

Can you insert it with the "Specify opposite corner" option?  (You have to use the command line to access this one).

I have done this before where my block was one unit square with the insertion point at the lower left corner. This allowed me to specify the opposite corner and get the varying x and y scales that I needed.

[myloveflyer]

Code: [Select]

(defun C:XSCALE(/ bp ss xscal yscal entL)

  (defun errexit (s)
    (princ "\nError:  ")
    (princ s)
    (restore)
  )

  (defun restore ()
    (setvar "CMDECHO" (car oldvar))
    (setq *error* olderr)
    (princ)
  )
 
(defun MAKEUNBLOCK (ss ip / tmp errexit mbx BLAYER)

  (setq T (not nil))
  (setq olderr  *error*
        *error* errexit
  )
  (setq oldvar
    (list
      (getvar "CMDECHO")
    )
  )
  (setvar "CMDECHO" 0)
  (terpri)
  (if BLAYER 
    (command "._LAYER"
      (if (tblsearch "LAYER" BLAYER) "_S" "_M")
      BLAYER
      ""
    )
  )
  (if (and ip ss)
    (progn
      (entmake (list
        (cons '0 "BLOCK")
        (cons '2 "*U")
        (cons '70 1)
        (cons '10 ip)
      ))
      (setq cnt (sslength ss))
      (while (>= (setq cnt (1- cnt)) 0)
        (setq tmp (ssname ss cnt))
        (entmake (setq el (entget tmp)))
        (if (> (cdr (assoc 66 el)) 0)
          (while
            (/= "SEQEND"
              (cdr
                (assoc 0
                  (entmake (setq el (entget (entnext (cdr (assoc -1 el))))))
                )
              )
            )
          )
        )
        (entdel tmp)
      )
      (setq tmp (entmake (list (cons '0 "ENDBLK"))))
      (entmake (list
        (cons '0 "INSERT")
        (cons '2 tmp)
        (cons '10 ip)
      ))
    )
  ) 
  (restore)
)

  (setq ss (ssget)) ;;;You can add the scaling type
  (if ss
    (progn
      (setvar "cmdecho" 0)
      (setq bp (getpoint "Scaling reference point (<0,0,0>): "))
      (if (not bp) (setq bp (list 0 0 0)))
      (setq xscal (getreal "X scale <1>: "))
      (if (not xscal) (setq xscal 1))
      (setq yscal (getreal "Y scale <1>: "))
      (if (not yscal) (setq yscal 1))
      (MAKEUNBLOCK ss bp)
      (setq entL (entget (entLast))
  entL (subst (cons 41 xscal) (assoc 41 entL) entL)
  entL (subst (cons 42 yscal) (assoc 42 entL) entL)
      )
      (entmod entL)
      (command "_explode" "l" "")
    )
  )
  (princ )

[chlh_jd]

Nice routine , Faster
If add osnap for grread , it would be perfect .

[chlh_jd]

according Faster's routine , I add osnap function .
about Osmark function you can see http://www.theswamp.org/index.php?topic=12813.0

Code: [Select]

(defun c:BlkDynscale
       (/ f1 f2 BLKREF EL BASE LOOP GR pt W H W1 H1 obj0 obj _err)
  ;; block dynamicly scale
  ;; by Faster
  ;; From http://www.theswamp.org/index.php?topic=42599.0
  ;; Edited by GSLS(SS) 2012-9-5
  ;;     ---- ADD Osnap function
  (setq _err *error*)
 (defun *error* (msg)
    (command)
    (command)
    (if (or (= msg "Function cancelled")
    (= msg "quit / exit abort")
)
      (princ msg)
      (princ (strcat "\n错误: " msg))
    )
    (or (vlax-erased-p obj) (vla-delete obj))
    (sssetfirst (ssadd blkref) nil)
    (redraw)
    (setq *error* _err)
    (princ)
    ) 
  (defun f1  (/ ig lst mid m)
    (or (vlax-erased-p obj) (vla-delete obj))
    (redraw)
    (setq pt (osnap (cadr gr)
    "_end,_mid,_cen,_nod,_qua,_int,_tan,_per,_nea"))
    (if pt
      (progn
(setq ig  T
      lst (list "_end" "_mid" "_cen" "_nod" "_qua" "_int" "_tan"
"_per" "_nea"))
(while (and ig lst)
  (setq mid (car lst)
lst (cdr lst)
)
  (if (equal pt (osnap (cadr gr) mid))
    (setq m  mid
  ig nil
  )
    )
  )
(if m
  (osMark (list pt m (cadr gr)))
  )
)
      )
    (or pt (setq pt (cadr gr)))
    )
  (defun f2  ()
    (mapcar (function set)
    (list (quote w1) (quote h1))
    (mapcar (function -) pt base))
    (if (or (zerop w1) (zerop h1))
      nil
      (progn
(setq xscale (* (abs xs) (/ w1 w))
      yscale (* (abs ys) (/ h1 h))
      )
(grdraw base pt 7 1)
(princ (strcat "\rXScale = "
       (rtos xscale 2 4)
       "  YScale = "
       (rtos yscale 2 4)
       "        "))
(setq obj (vla-copy obj0))
(vla-put-XScaleFactor obj xscale)
(vla-put-YScaleFactor obj yscale)
(vla-update obj)
)))
  (if
    (and
      (setq blkref (car (entsel "\nSelect a insert :")))
      (= "INSERT" (cdr (assoc 0 (entget blkref))))
      )
     (progn
       (setq el   (entget blkref)
     base (trans (cdr (assoc 10 el)) 0 1))
       (sssetfirst nil (ssadd blkref))
       (setq obj0 (vlax-ename->vla-object blkref))
       (setq obj (vla-copy obj0))
       (vla-GetBoundingBox
obj
(quote ll)
(quote ur))
       (mapcar
(function set)
(list (quote w) (quote h))
(apply
   (function mapcar)
   (cons
     (function -)
     (mapcar (function vlax-safearray->list) (list ur ll)))))
       (setq loop t
     xs   (vla-get-XScaleFactor obj)
     ys   (vla-get-YScaleFactor obj))
       (while (and (/= 25 (car (setq gr (grread T 1 1))))
   (/= (car gr) 11)
   (/= (car gr) 2)
   loop)
(cond
   ((and (= 5 (car gr)) (f1))
    (f2)
    )
   ((and (= 3 (car gr)) (f1))
    (setq loop nil)
    (redraw)
    (sssetfirst (ssadd blkref) nil)
    (f2)
    (vla-put-XScaleFactor obj0 xscale)
    (vla-put-YScaleFactor obj0 yscale)
    (vla-update obj0)
    (vla-delete obj)
    )
   )
)
       )
     )
  (redraw)
  (setq *error* _err) 
  (princ)
  )
(princ "\nDynamicly block Scale Routine written by Faster ,Edited by GSLS(SS) 2012-9-5，command : BlkDynScale .")
(princ)


[Hugo]

Get an error message

Bekomme eine Fehlermeldung

Command: BLKDYNSCALE
Select a insert :*Cancel*
Command:
Command:
??: no function definition: OSMARK

[Lee Mac]

Why not simply:

Code: [Select]

(defun c:bs ( / e1 e2 l1 l2 )
    (if (and (setq e1 (car (entsel "\nSelect Block: ")))
             (= "INSERT" (cdr (assoc 0 (setq l1 (entget e1)))))
        )
        (progn
            (setq e2 (entlast))
            (entdel e1)
            (vl-catch-all-apply 'vl-cmdf
                (list "_.-insert"
                    (cdr (assoc 02 l1)) "_R" (angtos (cdr (assoc 50 l1))) "_non"
                    (cdr (assoc 10 l1)) "_C" "\\"
                )
            )
            (entdel e1)
            (if (and (not (eq e2 (setq e2 (entlast))))
                     (= "INSERT" (cdr (assoc 0 (setq l2 (entget e2)))))
                )
                (progn
                    (foreach x '(41 42 43) (setq l1 (subst (assoc x l2) (assoc x l1) l1)))
                    (entmod l1)
                    (entdel e2)
                )
            )
        )
    )
    (princ)
)

[Hugo]

for me it does not work

bei mir funktioniert das nicht

[Lee Mac]

for me it does not work

The block definition of the selected block must permit non-uniform scaling, perhaps this is the cause?

[Hugo]

Block is set correctly when scaling is not hacking

Block ist richtig eingestellt bei Skalierung kein Hacken

Danke