Author Topic: Stretch attributes (enhanced)  (Read 623 times)

0 Members and 1 Guest are viewing this topic.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 988
  • Marco
Re: Stretch attributes (enhanced)
« Reply #15 on: April 09, 2019, 03:54:24 PM »
What if not all attribute references are inside the CW?
Was this question also for me?

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 988
  • Marco
Re: Stretch attributes (enhanced)
« Reply #16 on: April 10, 2019, 04:25:56 AM »
Edit: Rel. 1.01 more improvements

New version to solve drag image with many blocks (or big) in window:
Code: [Select]
; (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)))
« Last Edit: April 11, 2019, 03:13:15 AM by Marc'Antonio Alessi »