Edit: Rel. 1.01 more improvements
New version to solve drag image with many blocks (or big) in window:
; (ALE_Edit_StretchAttribsByLayer "*")
;
; LyrNms: Layer names - Wcmatch string > "Layer1,Layer2*" or "*" for all
;
(defun ALE_Edit_StretchAttribsByLayer (LyrNms / PntCr1 PntCr2 PntSt1 PntSt2 Ss_Str Ss_Blk EntNam EntDat Countr)
; Marc'Antonio Alessi - Rel. 1.01
(if
(and
(setq PntCr1 (getpoint "\nSpecify first corner of Crossing Window: "))
(not (initget 32))
(setq PntCr2 (getcorner PntCr1 "\nSpecify opposite corner: "))
)
(progn
(if (setq Ss_Str (ssget "_C" PntCr1 PntCr2 (list (cons 8 LyrNms))))
(progn
(setq Ss_Blk (ssadd))
(repeat (setq Countr (sslength Ss_Str))
(and
(= (DXF 0 (setq EntDat (entget (setq EntNam (ssname Ss_Str (setq Countr (1- Countr))))))) "INSERT")
(not (ALE_Math_InWindowP (DXF 10 EntDat) (list PntCr1 PntCr2)))
(setq Ss_Str (ssdel Entnam Ss_Str) Ss_Blk (ssadd Entnam Ss_Blk))
)
)
(princ "\nBase point: " ) (vl-cmdf "_.STRETCH" Ss_Str "" "\\") (setq PntSt1 (getvar "LASTPOINT"))
(princ "\nSecond point: " ) (vl-cmdf "\\" ) (setq PntSt2 (getvar "LASTPOINT"))
(repeat (setq Countr (sslength Ss_Blk))
(setq EntNam (ssname Ss_Blk (setq Countr (1- Countr))))
(mapcar
(function
(lambda (a)
(and
(ALE_Math_InWindowP (vlax-get a 'InsertionPoint) (list PntCr1 PntCr2))
(vla-move a (vlax-3d-point (trans PntSt1 1 0)) (vlax-3d-point (trans PntSt2 1 0)))
)
)
)
(vlax-invoke (vlax-ename->vla-object EntNam) 'getattributes)
)
)
)
(princ "\nNo Objects to Stretch found in Crossing Window.")
)
)
)
(princ)
)
(defun ALE_Math_InWindowP (TstPnt PntLst / LowLft UppRgt)
(setq
PntLst (mapcar '(lambda (x) (apply 'mapcar (cons x PntLst))) '(min max))
LowLft (car PntLst)
UppRgt (cadr PntLst)
)
(and
(< (car LowLft) (car TstPnt) (car UppRgt))
(< (cadr LowLft) (cadr TstPnt) (cadr UppRgt))
)
)
(defun Dxf (DxfCod EntDat) (cdr (assoc DxfCod EntDat)))