Scale lisp for Blocks in X-Axes
With their insertion points remaining where they are? If so, it would involve a simple SCALE command [which will preserve the X-Y ratio], with the insertion point as the base, and a scale factor of 2.5 ÷ the current X scale factor. Does that sound like what you want?
With a BIG PROVISO [see below], try this, which uses a different approach [just a Scale command, which means there's no need to calculate what the new XY scale factors should be, and if there's a Z component, also changes that accordingly], and also lets you select as many as you want at once, not one at a time:
(defun C:SBXS ; = Scale Blocks to same X-direction Size
(/ xs2 ss n blk xs1)
(if
(and
(setq xs2 (getdist "\nSize in X direction <exit>: "))
(setq ss (ssget '((0 . "INSERT"))))
); and
(repeat (setq n (sslength ss)); then
(setq blk (ssname ss (setq n (1- n))))
(vla-getboundingbox (vlax-ename->vla-object blk) 'minpt 'maxpt)
(setq xs1 (- (car (vlax-safearray->list maxpt)) (car (vlax-safearray->list minpt))))
(command "_.scale" blk "" "_non" (cdr (assoc 10 (entget blk))) (/ xs2 xs1))
); repeat
); if
(princ)
); defunThe BIG PROVISO is that you need to do something about your Block definitions. Both @ВeekeeCZ 's suggestion and mine depend on the bounding boxes of the Blocks. But those are wacky, much larger than the drawn content of the Blocks [hugely larger in some cases]. Here are some of them with their [white] bounding boxes drawn around them and the bounding boxes all the same width [I used the routine to scale them for that same width, and another routine I have to draw the bounding boxes around the results]:
The second and fourth are some of your green arrow things [almost invisibly small in the middle], and the third is the thing with the two yellow triangles [the actual content is invisibly small down along the bottom edge].
I haven't dug in to figure out why their bounding boxes are so much bigger than they themselves are, but you'll need to fix that for either of our routines to work as you expect.
@Garga wrote:
Ok I have explaind it more detailed.
(defun c:SithLord ( / acBlocks _HowBigAmI d ss e xy factor)
(setq acBlocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
(Defun _HowBigAmI (adb bn / pts) ;<--- excluding none visible objects
(vlax-for obj (vla-item adb bn)
(if (and
(not (vl-catch-all-error-p
(vl-catch-all-apply
'vla-getboundingbox (list obj 'll 'ur )))
)
(not (member (vla-get-ObjectName obj)
'("AcDbAttribute" "AcDbMText" ;<-- exclusding objects
"AcDbText" "AcDbHatch")))
(minusp (vlax-get obj 'Visible))) ;<-- excluding none visible objects
(setq pts (cons (mapcar 'car (mapcar 'vlax-safearray->list
(list ll ur) )) pts))
)
)
(list bn (apply '- (mapcar '(lambda (q r) (apply q (mapcar r pts)))
'(max min) '(cadr car) ))
)
)
(setq d (cond
((getdist (strcat "\nSpecify X-distance: <"
(rtos (setq d (cond ( d ) ( 1.00 ))))
">: " )))
( d )
)
)
(if (Setq ss (ssget "_:L" '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
xy (mapcar '(lambda (s)(vlax-get e s))
'("XScaleFactor" "YScaleFactor")))
(setq factor
(if (setq f (assoc (setq fn (vla-get-EffectiveName e)) WithData))(cadr f)
(cadar (setq WithData (Cons (_HowBigAmI acBlocks fn) WithData)))))
(setq r ( / d (* factor (car xy))))
(mapcar '(lambda (n m)
(vlax-put e n (* r m))) '("XScaleFactor" "YScaleFactor") xy)
)
)(princ)
)
HTH
