Routine to match block scales?

[vbcad]

Does anyone know of a routine or command i am not familiar with to match block scales? i need to match to xscale, yscale and zscale of a selected block then select the block to match the existing. The command would work similar to match properties. I tried to write the code myself but dont really know where to start. Lisp or VBA?

 

[CarlAK]

Here's a few suggestions that may help:
1. Have routine prompt for block to match scales, using 'entsel', like (setq EntMatch (entsel "\nSelect block to match: &quot)
2. Save the x-y-z scales of this entity, which are stored in the Group codes 41,42, and 43 respectively. So to get the x scale: (setq Xscale (cdr (assoc 41 (entget (car EntMatch)))))
3. Now have user select blocks to change scales to match:
(setq BlockSet (ssget '((0 . "INSERT&quot)))
4. Step through each member of BlockSet
5. (repeat (sslength BlockSet))
6. Substitute the scale data into the scale Group Codes, modify entity data.
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename))
(setq Oldx (assoc 41 Edata))
(setq Newx (subst (cons 41 Xscale) Oldx Edata))
(entmod Newx)
5. Do the same for y and z values
6. Update entity: (entupd Ename)
7. Increment 'Count'

Hope this gets you started!

 

[vbcad]

thanks that got me started here is what i have so far. Just a copy of the code.It errors out and i am not sure how to fix it. any ideas?

(DEFUN C:mscale ()
(setq EntMatch (entsel "\nSelect block to match: &quot)
(setq Xscale (cdr (assoc 41 (entget (car EntMatch)))))
(setq yscale (cdr (assoc 42 (entget (car EntMatch)))))
(setq zscale (cdr (assoc 43 (entget (car EntMatch)))))
(setq BlockSet (ssget '((0 . "INSERT&quot)))
(repeat (sslength BlockSet))
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename))
(setq Oldx (assoc 41 Edata))
(setq Newx (subst (cons 41 Xscale) Oldx Edata))
(entmod Newx)
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename))
(setq Oldy (assoc 42 Edata))
(setq Newy (subst (cons 42 Xscale) Oldy Edata))
(entmod Newy)
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename))
(setq Oldz (assoc 43 Edata))
(setq Newz (subst (cons 43 Xscale) Oldz Edata))
(entmod Newz)
(entupd Ename))

 

[CarlAK]

Well you got the bulk of it done. I rearranged it some, and put a comment next to a few things you left out. Try the following:

(princ "\nType MSCALE to start ";prompt user
(DEFUN C:mscale ()
(setq EntMatch (entsel "\nSelect block to match: &quot)
(redraw (car EntMatch) 3);;highlight selection
(setq Xscale (cdr (assoc 41 (entget (car EntMatch)))))
(setq yscale (cdr (assoc 42 (entget (car EntMatch)))))
(setq zscale (cdr (assoc 43 (entget (car EntMatch)))))
(setq Count 0);;counter for set items starts at 0
(setq BlockSet (ssget '((0 . "INSERT&quot)))
(repeat (sslength BlockSet)
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename));;orig insert data
(setq Oldx (assoc 41 Edata))
(setq Oldy (assoc 42 Edata))
(setq Oldz (assoc 43 Edata))
(setq Newdata (subst (cons 41 Xscale) Oldx Edata))
(setq Newdata (subst (cons 42 yscale) Oldy Newdata))
(setq Newdata (subst (cons 43 zscale) Oldz Newdata))
(entmod Newdata);;corrected spelling
(entupd Ename)
(setq Count (1+ Count));;increment counter
);end repeat
(redraw);;redraws the viewport
);end defun

 

[vbcad]

THANKS WORKS GOOD. ALL I ADDED WAS THIS AT THE END.

(redraw);;redraws the viewport
(command "regen&quot
);end defun

 

[vbcad]

I Ddiscovered an issue with the routine.When i use the routine to scale blocks without attributes it works fine however if the block has attributes they are not scaled with the rest of the block. I am using Acad 2004 and the block attribute manager fixes this with a couple of clicks. Just thought you may be curious. Any idea how to fix this?

 

[CarlAK]

You're right, the routine only rescaled the main block entity and not the attributes. A simple fix to that is to use the AutoCAD "scale" command within the routine. This appears to work OK for blocks with attributes, but would not work to rescale to a non-uniform scale. Let me know if the following code does the trick:

(princ "\nType MSCALE to start ";prompt user
(DEFUN C:mscale ()
(setvar 'cmdecho 0)
(setq EntMatch (entsel "\nSelect block to match: &quot)
(redraw (car EntMatch) 3);;highlight selection
(setq Xscale (cdr (assoc 41 (entget (car EntMatch)))))
(setq Count 0);;counter for set items starts at 0
(setq BlockSet (ssget '((0 . "INSERT&quot)))
(repeat (sslength BlockSet)
(setq Ename (ssname BlockSet Count))
(setq Edata (entget Ename));;orig insert data
(setq InsPt (cdr (assoc 10 Edata)))
(setq Oldx (cdr (assoc 41 Edata)))
(setq ScaleFac (/ Xscale Oldx))
(command "._scale" Ename "" InsPt ScaleFac)
(setq Count (1+ Count));;increment counter
);end repeat
(redraw)
(command "._regen&quot
(setvar 'cmdecho 1)
(princ)
);end defun

 

[vbcad]

works good so far thanks for the help. you have helped save me a huge amount of time