TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Marc'Antonio Alessi on April 20, 2020, 04:54:43 PM

Title: Rename and/or rotate block also nested
Post by: Marc'Antonio Alessi on April 20, 2020, 04:54:43 PM
I wrote this function which I consider very useful for renaming and/or rotating nested blocks. It is not written "very effectively" but for my use it is sufficient, it would be interesting to enhance it in order to be able to rename all the blocks above the selected nested block at the same time, does anyone have any suggestions?
(needs Doslib)

Code: [Select]
(defun C:ALE_Block_Cmd_Rename ( / InfLst EntDat FthEnt FthNam BlkObj BlkNam BlkEfN NewNam AngRot NewRot DclInf BlkDef DclStr FlgUpd DclLst Countr LevLst TmpDat Countr)
  (if
    (and
      (setq InfLst (ALE_Block_Cmd_NentselBlock "Select main or nested block to rename and/or rotate"))
      (setq BlkObj (vlax-ename->vla-object (caddr InfLst))   BlkNam (car InfLst)   EntDat (cadr InfLst))
      (vlax-property-available-p BlkObj 'Name)
    )
    (progn
      (setq
        BlkEfN (ALE_Block_Name BlkObj)
        AngRot (DXF 50 EntDat)
        DclLst (list (cons "Name" BlkEfN) (cons "Rotation" (RAG AngRot)))
      )
      (and (cadddr InfLst) (setq FthEnt (cadddr InfLst)  FthNam (DXF 2 (entget FthEnt))))
      (if (or (null FthNam) (= FthNam BlkNam))
        (setq DclStr (strcat "Rename and/or rotate selected block: " BlkEfN)  FthEnt nil)
        (progn
          (setq
            DclStr (strcat "Nested block: " BlkEfN "   of block at first level: " FthNam)
            LevLst (cdr (last (last InfLst)))
            Countr (1+ (length LevLst))
          )
          (foreach ForElm LevLst
            (setq
              DclLst (cons (cons (strcat "Level " (itoa Countr) "      -------------------------------------------") "-------------------------------------------") DclLst)
              TmpDat (entget ForElm)
              DclLst (cons (cons "Name" (DXF 2 TmpDat))    (cons  (cons "Rotation" (RAG (DXF 50 TmpDat))) DclLst))
              Countr (1- Countr)
            )
          )
          (setq DclLst (cons '("Level 1       -------------------------------------------" . "-------------------------------------------") DclLst))
        )
      )
      (setq
        DclInf (reverse (DOS_PROPLIST DclStr "" DclLst))
        NewNam (cdadr DclInf)
      )
      (while (and NewNam (/= (strcase BlkEfN) (strcase NewNam)) (tblsearch "BLOCK" NewNam))
        (setq
          DclInf (DOS_PROPLIST DclStr (strcat "Block: " NewNam  " already exist!") (list (cons "Name" NewNam) (cons "Rotation" (RAG AngRot))))
          NewNam (cdar DclInf)
        )
      )
      (cond
        ( (null NewNam) )
        ( (not (numberp (setq NewRot (distof (cdar DclInf))))) (alert "Rotation angle not valid!   ") )
        ( (equal (setq NewRot (GAR NewRot)) AngRot 0.001) )
        ( T  (vla-put-Rotation BlkObj NewRot) (setq FlgUpd T) )
      )
      (and
        NewNam
        (/= (strcase BlkEfN) (strcase NewNam))
        (and (setq BlkDef (ALE_Utl_GetItem *AcBlcks* BlkEfN)) (progn (vla-put-Name BlkDef NewNam) (setq FlgUpd T)))
      )
      (and
        FlgUpd
        (progn (entupd (caddr InfLst)) (and FthEnt (vla-regen *AcAcDwg* acActiveViewport)))
      )
    );progn
    (princ "\nNo block selected, command cancelled.   ")
  )
  (princ)
)
Code: [Select]
(defun ALE_Block_Cmd_NentselBlock (PrmStr / EntDat EntNam BlkNam EntLst UpdNam)
  (if (setq EntLst (nentsel (strcat "\n" PrmStr ": ")))
    (progn
      (if (= (length EntLst) 4)
        (progn
          (if (and (= "DIMENSION" (DXF 0 (entget (car (last EntLst))))) (cdr (last EntLst)))
            (setq EntLst (list (car EntLst) (cdr (last EntLst))))
          );if
          (setq
            UpdNam (DXF -1 (entget (last (last EntLst))))
            EntNam (car (last EntLst))
          )
          (if (setq EntDat (entget EntNam)) (setq BlkNam (DXF 2 EntDat)));if
        );progn
        (progn
          (setq EntNam (car EntLst))
          (if (= "ATTRIB" (DXF 0 (entget EntNam)))
            (progn
              (setq EntNam (ssname (ssget (cadr EntLst)) 0))
              (if (setq EntDat (entget EntNam)) (setq BlkNam (DXF 2 EntDat)));if
            );progn
          );if
        );progn
      );if
    );progn
    (princ "\nNothing selected, command cancelled.   ")
  );if
  (if (and BlkNam (= "INSERT" (DXF 0 EntDat)))
    (list BlkNam EntDat EntNam UpdNam EntLst)
  )
)


(defun Dxf (DxfCod EntDat)  (cdr (assoc DxfCod EntDat)))

(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
  (vl-catch-all-apply
   '(lambda ( )
      (setq VlaObj (vla-item VlaCol KeyNam))
    )
  )
  VlaObj
)

(defun ALE_Block_Name (BlkObj)
  (if (vlax-property-available-p BlkObj 'effectivename)
    (vla-get-effectivename BlkObj)
    (vla-get-name BlkObj)
  )
)
Title: Re: Rename and/or rotate block also nested
Post by: MP on April 20, 2020, 05:26:59 PM
No time to play but the first thing I would do is break down the solution into it's atomic parts - functions that do precisely one thing. e.g. rename_block, rotate_block etc. Modifying or extending a monolithic solution is more work than than revising one based upon bringing together requisite atomic functions. Bonus: atomic functions generally lend themselves to the DRY principle (don't repeat yourself), i.e. a library. Cheers.
Title: Re: Rename and/or rotate block also nested
Post by: Marc'Antonio Alessi on April 21, 2020, 09:58:45 AM
After following Michael's tips it seems to be working properly…
Code: [Select]
(defun C:ALE_Block_Cmd_TreeRename ( / BlkDef BlkEfN BlkNam BlkObj Countr DclInf DclLst DclStr EntDat FthEnt
                                      FthNam InfLst LevLst OldNam TmpDat TmpFlg TmpNam TmpPrp TrueFl)                 
  (if
    (and
      (setq InfLst (ALE_Block_Cmd_NentselBlock "Select main or nested block to rename"))
      (setq BlkObj (vlax-ename->vla-object (caddr InfLst))   BlkNam (car InfLst)   EntDat (cadr InfLst))
      (vlax-property-available-p BlkObj 'Name)
    )
    (progn
      (setq BlkEfN (ALE_Block_Name BlkObj)   TrueFl T)
      (and (cadddr InfLst) (setq FthEnt (cadddr InfLst)  FthNam (DXF 2 (entget FthEnt))))
      (if (or (null FthNam) (= FthNam BlkNam))
        (setq
          DclLst (list (cons "Name" BlkEfN))
          DclStr (strcat "Rename selected block: " BlkEfN)
        )
        (progn
          (setq
            LevLst (cdr (reverse (cdr (reverse (last (last InfLst))))))
            Countr (+ 2 (length LevLst))
            DclLst (list (cons (strcat "Level " (itoa Countr) "  Name:") BlkEfN))
            DclStr (strcat "Rename nested block: " BlkEfN "   of block at first level: " FthNam)
          )
          (foreach ForElm LevLst
            (setq
              Countr (1- Countr)
              TmpDat (entget ForElm)
              DclLst (cons (cons (strcat "Level " (itoa Countr) "  Name:") (DXF 2 TmpDat)) DclLst)
            )
          )
          (setq DclLst (cons (cons (strcat "Level " (itoa (1- Countr)) "  Name:") FthNam) DclLst))
        )
      )
      (setq DclInf (DOS_PROPLIST DclStr "" DclLst))
      (or
        (null DclInf)
        (equal DclInf DclLst)
        (while TrueFl
          (setq TmpPrp ""   TrueFl nil)
          (foreach ForElm DclInf
            (setq TmpFlg nil)
            (if (= (setq TmpNam (cdr ForElm)) (setq OldNam (DXF (car ForElm) DclLst)))
              (setq TmpFlg nil)
              (if (tblsearch "BLOCK" TmpNam)
                (setq TmpFlg T  TmpPrp (strcat TmpPrp "Block: " TmpNam  " exist! "))
                (progn
                  (setq BlkDef (ALE_Utl_GetItem *AcBlcks* OldNam))
                  (vla-put-Name BlkDef TmpNam)
                  (setq
                    DclLst (subst (cons (car ForElm) TmpNam) (assoc (car ForElm) DclLst) DclLst)
                    TmpFlg nil
                  )
                )
              )
            )
            (and TmpFlg (setq TrueFl T))
          )
          (and TrueFl (setq DclInf (DOS_PROPLIST DclStr TmpPrp DclLst)))
        )
      )
    );progn
    (princ "\nNo block selected, command cancelled.   ")
  )
  (princ)
)
Title: Re: Rename and/or rotate block also nested
Post by: MP on April 21, 2020, 04:00:01 PM
If you're :-) I'm :-).
Title: Re: Rename and/or rotate block also nested
Post by: Marc'Antonio Alessi on April 21, 2020, 04:05:43 PM
We are  :) :)
Title: Re: Rename and/or rotate block also nested
Post by: MP on April 21, 2020, 04:12:25 PM
 :lol: :-D
Title: Re: Rename and/or rotate block also nested
Post by: Marc'Antonio Alessi on April 23, 2020, 11:13:18 AM
I improved a little bit the ALE_Block_Cmd_NentselBlock function (which I had written in the last century...), it is still not very efficient selecting attributes in nested or not blocks.  :?
Code: [Select]
(defun ALE_Block_Cmd_NentselBlock (PrmStr / EntDat EntNam BlkNam EntLst UpdNam)
; 20200423 - R.1.10
  (if (setq EntLst (nentsel (strcat "\n" PrmStr ": ")))
    (progn
      (if (= (length EntLst) 4)
        (progn
          (and
            (= "DIMENSION" (DXF 0 (entget (car (last EntLst)))))
            (cdr (last EntLst))
            (setq EntLst (list (car EntLst) (cdr (last EntLst))))
          )
          (and
            (setq UpdNam (DXF -1 (entget (last (last EntLst)))))
            (setq EntNam (car (last EntLst)))
            (setq EntDat (entget EntNam))
            (= "INSERT" (DXF 0 EntDat))
            (setq BlkNam (ALE_Block_Name (vlax-ename->vla-object EntNam)))
          )
        )
        (and
          (setq EntNam (car EntLst))
          (= "ATTRIB" (DXF 0 (entget EntNam)))
          (setq EntNam (ssname (ssget (cadr EntLst)) 0))
          (setq EntDat (entget EntNam))
          (= "INSERT" (DXF 0 EntDat))
          (setq BlkNam (ALE_Block_Name (vlax-ename->vla-object EntNam)))
        )
      )
    )
    (princ "\nNothing selected, command cancelled.   ")
  );if
  (if BlkNam (list BlkNam EntDat EntNam UpdNam EntLst))
)
;
(defun Dxf (DxfCod EntDat)  (cdr (assoc DxfCod EntDat)))