TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Marc'Antonio Alessi on April 08, 2019, 05:12:42 AM

Title: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 08, 2019, 05:12:42 AM
Perhaps it has already been solved ...
Title: Re: Stretch attributes (enhanced)
Post by: ribarm on April 08, 2019, 06:48:36 AM
Your attributes have Lock Position parameter turned on - it's default, but you should have unchecked it for stretching if you had that in mind...
I don't know, but perhaps some DXF code could be an answer to turning it off through code...
Title: Re: Stretch attributes (enhanced)
Post by: VovKa on April 08, 2019, 07:04:56 AM
https://www.theswamp.org/index.php?topic=19886.0
https://www.theswamp.org/index.php?topic=19881.0
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 08, 2019, 08:34:59 AM
@Marko: try to use stretch on attribs… (insert point of block must be outside of window)

@Vovka:  think  "MOVEATT (gile) 07/05/08" it is the one that comes closest to my needs, but there is still no function that also combines the stretch command…

Grazie.
Title: Re: Stretch attributes (enhanced)
Post by: ribarm on April 08, 2019, 10:04:03 AM
@Marc' Antonio
I've checked it and it works no matter Lock Position yes or no... The problem is that your stretching window is wrong - it should be from upper left to lower right point... Check it with this procedure and reply if again you have problem...

M.R.
Title: Re: Stretch attributes (enhanced)
Post by: ronjonp on April 08, 2019, 10:11:23 AM
Post your drawing .. I can't replicate that behavior.
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 08, 2019, 10:26:50 AM
Here my dwg. Thanks.   :-)
Title: Re: Stretch attributes (enhanced)
Post by: ribarm on April 08, 2019, 02:47:18 PM
OK... It doesn't work, but try this quick fix :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:statt ( / pp1 pp2 ss p1 p2 blkrefs blkrefptlst blkrefptlstn )
  2.  
  3.  
  4.   (if (and (not (prompt "\nSelect objects: ")) (setq pp1 (getpoint)) (setq pp2 (getcorner pp1)))
  5.     (progn
  6.       (vl-cmdf "_.select" "_box" "_non" pp1 "_non" pp2)
  7.       (while (< 0 (getvar 'cmdactive))
  8.         (vl-cmdf "\\")
  9.       )
  10.       (if (setq ss (ssget "_P"))
  11.         (progn
  12.           (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  13.             (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget e))))))))
  14.               (ssdel e ss)
  15.             )
  16.           )
  17.           (if (/= (sslength ss) 0)
  18.             (progn
  19.               (setq blkrefs (vl-remove-if-not '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "INSERT")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
  20.               (setq blkrefptlst (mapcar '(lambda ( x ) (list x (assoc 10 (entget x)))) blkrefs))
  21.               (initget 1)
  22.               (setq p1 (getpoint "\nPick or specify base point : "))
  23.               (initget 1)
  24.               (setq p2 (getpoint p1 "\nPick or specify destination point : "))
  25.               (vl-cmdf "_.stretch" ss "" "_non" p1 "_non" p2)
  26.               (setq blkrefptlstn (mapcar '(lambda ( x ) (list x (assoc 10 (entget x)))) blkrefs))
  27.               (foreach blkref (mapcar 'car (vl-remove-if-not '(lambda ( x ) (vl-position x blkrefptlst)) blkrefptlstn))
  28.                 (if (= (cdr (assoc 66 (entget blkref))) 1)
  29.                   (foreach att (vlax-invoke (vlax-ename->vla-object blkref) 'getattributes)
  30.                     (if
  31.                       (and
  32.                         (< (apply 'min (mapcar 'car (list pp1 pp2))) (car (cdr (assoc 10 (entget (vlax-vla-object->ename att))))) (apply 'max (mapcar 'car (list pp1 pp2))))
  33.                         (< (apply 'min (mapcar 'cadr (list pp1 pp2))) (cadr (cdr (assoc 10 (entget (vlax-vla-object->ename att))))) (apply 'max (mapcar 'cadr (list pp1 pp2))))
  34.                       )
  35.                       (vla-move att (vlax-3d-point p1) (vlax-3d-point p2))
  36.                     )
  37.                   )
  38.                 )
  39.               )
  40.               (foreach blkref (mapcar 'car (vl-remove-if '(lambda ( x ) (vl-position x blkrefptlst)) blkrefptlstn))
  41.                 (if (= (cdr (assoc 66 (entget blkref))) 1)
  42.                   (foreach att (vlax-invoke (vlax-ename->vla-object blkref) 'getattributes)
  43.                     (if
  44.                       (not
  45.                         (and
  46.                           (< (apply 'min (mapcar 'car (list pp1 pp2))) (car (cdr (assoc 10 (entget (vlax-vla-object->ename att))))) (apply 'max (mapcar 'car (list pp1 pp2))))
  47.                           (< (apply 'min (mapcar 'cadr (list pp1 pp2))) (cadr (cdr (assoc 10 (entget (vlax-vla-object->ename att))))) (apply 'max (mapcar 'cadr (list pp1 pp2))))
  48.                         )
  49.                       )
  50.                       (vla-move att (vlax-3d-point p2) (vlax-3d-point p1))
  51.                     )
  52.                   )
  53.                 )
  54.               )
  55.             )
  56.           )
  57.         )
  58.       )
  59.     )
  60.   )
  61.   (princ)
  62. )
  63.  

BTW. I should have said that it's always better if Lock Position is NO... And yes this sort of thing is job for Autodesk - they should find correct solution and fix the problem... In my testings - if Lock Position NO and you select attribute upper left - lower right it may work, but I tested with one attribute and sometimes it could fail...
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 08, 2019, 03:26:46 PM
@marko  can you please post a video?

Title: Re: Stretch attributes (enhanced)
Post by: ribarm on April 08, 2019, 05:35:37 PM
@marko  can you please post a video?

You have to test it and see if that's what you're looking for...
Code slightly changed...

Regards, M.R.
BTW. Now it doesn't matter how do you pick window... It is assumed that you work with WCS...
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 09, 2019, 02:25:25 AM
@marko  can you please post a video?

You have to test it and see if that's what you're looking for...
Code slightly changed...

Regards, M.R.
BTW. Now it doesn't matter how do you pick window... It is assumed that you work with WCS...
Ok now it works. I try if I can modify it to see the objects during the drag (even without the attributes). Thank you so much for your time.  :-)
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 09, 2019, 04:12:25 AM
Maybe this is very simple (need to see attribs on drag), with a layer filter...
Code: [Select]
; (ALE_Edit_StretchAttribLayer "*")
;
(defun ALE_Edit_StretchAttribLayer (LyrNms / Pnt001 Pnt002 Ss_Str EntNam Countr)
  (if
    (and
      (setq Pnt001 (getpoint "\nSpecify first corner of Crossing Window: "))
      (not (initget 32))
      (setq Pnt002 (getcorner Pnt001 "\nSpecify opposite corner: "))
    )
    (progn
      (if (setq Ss_Str (ssget "_C" Pnt001 Pnt002 (list (cons 8 LyrNms))))
        (progn
          (princ "\nBase point: "   ) (vl-cmdf "_.STRETCH" Ss_Str "" "\\") (setq Pnt001 (getvar "LASTPOINT"))
          (princ "\nSecond point: " ) (vl-cmdf "\\"                      ) (setq Pnt002 (getvar "LASTPOINT"))
          (repeat (setq Countr (sslength Ss_Str))
            (and
              (= (cdr (assoc 0 (entget (setq EntNam (ssname Ss_Str (setq Countr (1- Countr))))))) "INSERT")
      (mapcar
        (function
          (lambda (a)
            (vla-move a (vlax-3d-point (trans Pnt001 1 0)) (vlax-3d-point (trans Pnt002 1 0)))
          )
        )
        (vlax-invoke (vlax-ename->vla-object EntNam) 'getattributes)
      )
            ) 
          )         
        )
        (princ "\nNo Objects to Stretch found in Crossing Window.")
      )
    )
  )
  (princ)
)
Title: Re: Stretch attributes (enhanced)
Post by: roy_043 on April 09, 2019, 09:27:47 AM
What if not all attribute references are inside the CW?
Title: Re: Stretch attributes (enhanced)
Post by: ribarm on April 09, 2019, 09:40:53 AM
What if not all attribute references are inside the CW?

You should have tested my code...
Title: Re: Stretch attributes (enhanced)
Post by: roy_043 on April 09, 2019, 09:50:38 AM
What if not all attribute references are inside the CW?

You should have tested my code...
I actually have, but I see you have revised it. Your previous code did have this problem.
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi on April 09, 2019, 03:54:24 PM
What if not all attribute references are inside the CW?
Was this question also for me?
Title: Re: Stretch attributes (enhanced)
Post by: Marc'Antonio Alessi 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)))