Jump to content

Rotate attribute Reactor

markv

By markv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

markv Contributor

markv

Posted
Posted

I have downloaded a reactor lisp (not my code, no author given) that is supposed to rotate attributes to zero when a block is inserted, however it does not appear to work. I cannot figure out why. Some areas are commented out. I see the Execute tool is in the code. I insert a block from a tool palette and it does not rotate. Thanks for help in advance

 

 
(defun Attributs_ini(Rea Cde)
 (setq dernier_ent (entlast))
)
(defun Attributs_rot_0(Rea Cde / bl js i n)
 (cond
   ((eq (car Cde) "EXECUTETOOL")
     (setq js (ssget "_L"))
   )
   ((eq (car Cde) "ROTATE")
     (setq js (ssget "_p"))
   )
   ((eq (car Cde) "MIRROR")
     (setq js (ssget "_p"))
   )
   ((eq (car Cde) "GRIP_ROTATE")
     (setq js (cadr (ssgetfirst)))
   )
   ((eq (car Cde) "GRIP_MIROR")
     (setq js (cadr (ssgetfirst)))
   )
;    ((eq (car Cde) "INSERT")
;      (setq js (ssadd))
;      (ssadd (entlast) js)
;    )
;    ((eq (car Cde) "COPY")
;      (setq js (ssadd) n (entnext dernier_ent))
;      (while n
;        (ssadd n js)
;        (setq n (entnext n))
;      )
;    )
;    ((eq (car Cde) "UCS")
;      (setq js (ssget "x" (list (cons 0 "INSERT"))))
;    )
 )
 (if js
   (progn
     (setq n 0)
     (while (ssname js n)
       (setq bl (entget (ssname js n)))
       (if (eq (cdr (assoc 0 bl)) "INSERT")
         (if (cdr (assoc 66 bl))
           (progn
             (while (not (eq (cdr (assoc 0 bl)) "SEQEND"))
               (if (eq (cdr (assoc 0 bl)) "ATTRIB")
                 (progn
                   (setq bl (subst (cons 50 0) (assoc 50 bl) bl))
                   (entmod bl)
                   (entupd (cdr (assoc -1 bl)))
                 )
               )
               (setq bl (entget (entnext (cdr (assoc -1 bl)))))
             )
           )
         )
       )
       (setq n (1+ n))
     )
   )
 )
 (princ)
)
(defun c:srot0(/ i j n)
 (if (setq i (vlr-reactors :vlr-Command-Reactor))
   (progn
     (setq n 1 i (nth n (car i)))
     (while i
       (setq j nil)
       (if (or (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_ROT_0) (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_INI))
         (setq j i)
       )
       (if j
         (vlr-remove j)
         (setq n (1+ n))
       )
       (if (setq i (vlr-reactors :vlr-Command-Reactor))
         (setq i (nth n (car i)))
       )
     )
     (if mrea_rot0
       (princ "\n\tDisable angle 0 of the Attributes")
     )
     (setq mrea_rot nil)
   )
 )
 (princ)
)
(defun c:rot0()
 (if (not mrea_rot0)
   (progn
     (c:srot0)
     (vlr-command-reactor nil '((:vlr-commandwillstart . Attributs_ini)))
     (setq mrea_rot0 (vlr-command-reactor nil '((:vlr-commandEnded . Attributs_rot_0))))
     (princ "\n\tEnable angle 0 of the Attributes")
   )
   (princ "\n\tAngle 0 of the Attributes is ready")
 )
 (princ)
)
(vl-load-com)
(princ (strcat "\n\tFor enable angle 0 of the Attributes, command ROT0.\n\tfor backward, command SROT0."))
(princ)

  • Replies 51
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    23

  • MarcoW

    15

  • markv

    9

  • YvaaT

    3

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac Grand Master

Lee Mac

Posted
Posted

Just to get you a fix, how about this from ASMI?

 

;; ==================================================================== ;;
;;                                                                      ;;
;;  ATRON.LSP - This program reacts to an insertion of the block with   ;;
;;              attributes (INSERT command). After block insertion and  ;;
;;              rotation it set an angle of attributes equal 0° and     ;;
;;              allows to move attributes to the necessary place.       ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: ARTON - turn reactor ON                         ;;
;;                      ATROFF - turn reactor OFF                       ;;
;;                                                                      ;;
;;  The program itself will react to any insert of the block with       ;;
;;  attributes. To turn on reactor automatically add in the end         ;;
;;  of the this file AutoLISP expression (c:atron).                     ;;
;;                                                                   ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.2, 20th Feb 2009, Riga, Latvia                                   ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;                                      http://www.asmitools.com        ;;
;;                                                                      ;;
;; ==================================================================== ;;


(defun c:atron()
 
 (vl-load-com)
 
 (if(not aton:cmdreactor)
   (progn
     (setq aton:cmdreactor
      (vlr-Command-Reactor nil
        '((:vlr-CommandEnded . Atron_Arrange_Attributes))))
     (princ "\n<<< ATTRIBUTE REACTOR now ON >>> ")
     ); end progn
   (princ "\n<<< Insert reactor already ON! Type ATROFF to OFF >>> ")
   );end if
 (princ)
 ); end of c:atron

(defun c:atroff()
 (if aton:cmdreactor
   (progn
     (vlr-remove aton:cmdreactor)
     (setq aton:cmdreactor nil)
     (princ "\n<<< ATTRIBUTE REACTOR now OFF >>> ")
    ); end progn
   ); end if
 (princ)
 ); end of c:atroff

(defun Atron_Arrange_Attributes (Reac Args / cBl atLst minPt maxPt
               ptLst cPt errCnt rAng mPt xPt laySt
               pLst mX mY xX xY p1 p2 p3 p4 hX hY
               sPt grDat fPt stFlag actDoc stFlag
               stopFlag *error*)

(defun asmi-GetAttributes(Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr(vl-catch-all-apply 'vlax-safearray->list
            (list(vlax-variant-value
                    (vla-GetAttributes Block)))))))
          atArr); end if
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr(vl-catch-all-apply 'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr); end if
     ); end append
   ); end asmi-GetAttributes

(defun asmi-LayersUnlock(/ restLst)
 (setq restLst '())
 (vlax-for lay(vla-get-Layers
    (vla-get-ActiveDocument
      (vlax-get-acad-object)))
        (setq restLst
          (append restLst
            (list
              (list
                lay
                 (vla-get-Lock lay)
                ); end list
              ); end list
            ); end append
          ); end setq
       (vla-put-Lock lay :vlax-false)
     ); end vlax-for
  restLst
 ); end of asmi-LayersUnlock

 (defun asmi-LayersStateRestore(StateList)
   (foreach lay StateList
     (vla-put-Lock(car lay)(cadr lay))
    ); end foreach
   (princ)
 ); end of asmi-LayersStateRestore

 (defun *error*(msg)
   (if stFlag
     (vla-EndUndoMark actDoc)
     ); end if
   (redraw)
   (princ(strcat "\n" msg))
   (princ)
   ); end of *error*
 
 (if
   (and
     (or
       (= "INSERT"(car Args))
       (= "EXECUTETOOL"(car Args))
      ); end or
     (entlast)
     (= "INSERT"(cdr(assoc 0(entget(entlast)))))
     (= :vlax-true
     (vla-get-HasAttributes
        (setq cBl(vlax-ename->vla-object(entlast)))))
     ); end and
   (progn
     (vla-GetBoundingBox cBl 'minPt 'maxPt)
     (setq atLst(asmi-GetAttributes cBl)
       ptLst(mapcar 'vlax-safearray->list(list maxPt minPt))
       cPt(vlax-3d-Point
        (mapcar '+(cadr ptLst)
          (mapcar '/(mapcar '-
            (car ptLst)(cadr ptLst))'(2 2 1))))
       rAng(vla-get-Rotation cBl)
       actDoc(vla-get-ActiveDocument
           (vlax-get-acad-object))
       laySt(asmi-LayersUnlock)
       ); end setq
     (setq stFlag T)
     (vla-StartUndoMark actDoc)
     (foreach att atLst
   (if(= ""(vla-get-TextString att))
     (vla-put-TextString att(strcat "!#"(vla-get-TagString att)))
     ); end if
   (if(vl-catch-all-error-p
        (vl-catch-all-apply 'vla-Rotate
          (list att cPt (- rAng)))) nil
     (progn
       (vla-GetBoundingBox att 'mPt 'xPt)
       (setq pLst
          (append pLst
           (mapcar 'vlax-safearray->list
                     (list mPt xPt)))
         ); end setq
       ); end progn
     ); end if
   ); end foreach
     (setq mX(vl-sort pLst '(lambda(a b)(<(car a)(car b))))
       mY(vl-sort pLst '(lambda(a b)(<(cadr a)(cadr b))))
       xX(vl-sort pLst '(lambda(a b)(>(car a)(car b))))
       xY(vl-sort pLst '(lambda(a b)(>(cadr a)(cadr b))))
       hX(/(-(caar xX)(caar mX))2) hY(/(-(cadar xY)(cadar mY))2)
       fPt(list(+(caar mX)hX)(+(cadar mY)hY)0.0)
       ); end setq
     (princ "\n<<< Move attributes or Right Click to stay >>> ")
     (while(and
         (/= 3(car(setq grDat(grread T 1))))
         (not stopFlag)
         ); end or
   (redraw)
   (if(= 'LIST(type(setq sPt(cadr grDat))))
     (progn
      (setq p1(list(-(car sPt)hX)(-(cadr sPt)hY))
            p2(list(-(car sPt)hX)(+(cadr sPt)hY))
            p3(list(+(car sPt)hX)(+(cadr sPt)hY))
            p4(list(+(car sPt)hX)(-(cadr sPt)hY))
         ); end setq
       (grdraw p1 p2 3)(grdraw p2 p3 3)
       (grdraw p3 p4 3)(grdraw p4 p1 3)
      ); end progn
        (if(= 25(car grDat))
               (setq sPt fPt
             stopFlag T); end setq
       ); end if
     ); end if
   ); end while
     (redraw)
     (foreach att atLst
   (if(vl-catch-all-error-p
        (vl-catch-all-apply 'vla-Move
          (list att(vlax-3D-point fPt)
               (vlax-3D-point(trans sPt 1 0)))))
     nil
     ); end if
   (if(wcmatch(vla-get-TextString att) "!`#*")
     (vla-put-TextString att "")
     ); end if
   ); end foreach
      (if(and
      (= "EXECUTETOOL"(car Args))
      (= 1(getvar "ATTREQ"))
      ); and end
            (vla-Eval(vlax-get-acad-object)
        (strcat "ThisDrawing.SendCommand"
            "\"_.acdcattedit\"" "& vbCr"))
     ); end if
     (if laySt(asmi-LayersStateRestore laySt))
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (princ)
 ); end of Atron_Arrange_Attributes

(princ "\n[info] http:\\\\www.AsmiTools.com [info]")
(princ "\n[info] Type ATRON for attribute reactor and ATROFF to swictch off [info]")

Lee Mac Grand Master

Lee Mac

Posted
Posted

This is the way I would write it, type 'ZeroAtt' to toggle the reactor:

 

[i][color=#990099];; ZeroAtt                                   ;;[/color][/i]
[i][color=#990099];; Lee Mac  ~  03.03.10                      ;;[/color][/i]
[i][color=#990099];; Sets Attribute Rotation to zero upon      ;;[/color][/i]
[i][color=#990099];; block insertion.                          ;;[/color][/i]
[i][color=#990099];; Type 'ZeroAtt' to Activate and Deactivate ;;[/color][/i]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:ZeroAtt [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] Reac[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-COM[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Reac
       [b][color=RED]([/color][/b][b][color=BLUE]vl-some[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]reactor[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"Zero-Att"[/color][/b]
                   [b][color=RED]([/color][/b][b][color=BLUE]vlr-data[/color][/b] reactor[b][color=RED])[/color][/b][b][color=RED])[/color][/b] reactor[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]cdar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-reactors[/color][/b] [b][color=Blue]:vlr-command-reactor[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-added-p[/color][/b] Reac[b][color=RED])[/color][/b]
     
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-remove[/color][/b] Reac[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-add[/color][/b] Reac[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Reac
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-command-reactor[/color][/b] [b][color=#a52a2a]"Zero-Att"[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=Blue]:vlr-commandEnded[/color][/b] [b][color=DARKRED]'[/color][/b]ZeroAttribs[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-added-p[/color][/b] Reac[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** ZeroAtt Reactor Activated **"[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** ZeroAtt Reactor Deactivated **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]


[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] ZeroAttribs [b][color=RED]([/color][/b]Reactor Args [b][color=BLUE]/[/color][/b] *error* GetLocked PutLocked
                                         ENT LOCKED OBJ UFLAG[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]  

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetLocked [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] lst[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] lay [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Layers[/color][/b] *doc[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-lock[/color][/b] lay[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] lay lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]vla-put-lock[/color][/b] lay [b][color=Blue]:vlax-false[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   lst[b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PutLocked [b][color=RED]([/color][/b]lst[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-put-lock[/color][/b] x [b][color=Blue]:vlax-true[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *doc [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]*doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] Args[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"*INSERT"[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]entlast[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"AcDbBlockReference"[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ObjectName[/color][/b]
                [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-HasAttributes[/color][/b] obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag  [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           Locked [b][color=RED]([/color][/b]GetLocked[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] att [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] obj [b][color=DARKRED]'[/color][/b]GetAttributes[b][color=RED])[/color][/b]
                          [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] obj [b][color=DARKRED]'[/color][/b]GetConstantAttributes[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

       [b][color=RED]([/color][/b][b][color=BLUE]vla-put-rotation[/color][/b] att [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b]PutLocked Locked[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

dober Enthusiast

dober

Posted
Posted
This is the way I would write it, type 'ZeroAtt' to toggle the reactor:

 

[i][color=#990099];; ZeroAtt                                   ;;[/color][/i]
[i][color=#990099];; Lee Mac  ~  03.03.10                      ;;[/color][/i]
[i][color=#990099];; Sets Attribute Rotation to zero upon      ;;[/color][/i]
[i][color=#990099];; block insertion.                          ;;[/color][/i]
[i][color=#990099];; Type 'ZeroAtt' to Activate and Deactivate ;;[/color][/i]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:ZeroAtt [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] Reac[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-COM[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Reac
       [b][color=RED]([/color][/b][b][color=BLUE]vl-some[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]reactor[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"Zero-Att"[/color][/b]
                   [b][color=RED]([/color][/b][b][color=BLUE]vlr-data[/color][/b] reactor[b][color=RED])[/color][/b][b][color=RED])[/color][/b] reactor[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

         [b][color=RED]([/color][/b][b][color=BLUE]cdar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-reactors[/color][/b] [b][color=Blue]:vlr-command-reactor[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-added-p[/color][/b] Reac[b][color=RED])[/color][/b]
     
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-remove[/color][/b] Reac[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-add[/color][/b] Reac[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Reac
     [b][color=RED]([/color][/b][b][color=BLUE]vlr-command-reactor[/color][/b] [b][color=#a52a2a]"Zero-Att"[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=Blue]:vlr-commandEnded[/color][/b] [b][color=DARKRED]'[/color][/b]ZeroAttribs[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlr-added-p[/color][/b] Reac[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** ZeroAtt Reactor Activated **"[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** ZeroAtt Reactor Deactivated **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]


[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] ZeroAttribs [b][color=RED]([/color][/b]Reactor Args [b][color=BLUE]/[/color][/b] *error* GetLocked PutLocked
                                         ENT LOCKED OBJ UFLAG[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]  

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetLocked [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] lst[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] lay [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Layers[/color][/b] *doc[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-lock[/color][/b] lay[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] lay lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]vla-put-lock[/color][/b] lay [b][color=Blue]:vlax-false[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   lst[b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PutLocked [b][color=RED]([/color][/b]lst[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-put-lock[/color][/b] x [b][color=Blue]:vlax-true[/color][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *doc [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]*doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                            [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] Args[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"*INSERT"[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]entlast[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"AcDbBlockReference"[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ObjectName[/color][/b]
                [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-HasAttributes[/color][/b] obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag  [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           Locked [b][color=RED]([/color][/b]GetLocked[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] att [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] obj [b][color=DARKRED]'[/color][/b]GetAttributes[b][color=RED])[/color][/b]
                          [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] obj [b][color=DARKRED]'[/color][/b]GetConstantAttributes[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

       [b][color=RED]([/color][/b][b][color=BLUE]vla-put-rotation[/color][/b] att [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b]PutLocked Locked[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 

 

Hello Lee

 

That would be cool wen it went well with texts.

Since I have blocks with texts.

 

 

Hallo Lee

 

Das wäre cool wen das auch mit Texten ging.

Da ich Blöcke auch mit Texten habe.

Lee Mac Grand Master

Lee Mac

Posted
Posted
Hello Lee

 

That would be cool wen it went well with texts.

Since I have blocks with texts.

 

I could be wrong but I think that would mean changing the block definition - not something that you want to really do. I hope to stand corrected though.

markv Contributor

markv

Posted
  • Author
Posted

Thanks Lee. What would I have to do to make this work when I use different commands like copying a block, insert from toold palette etc. Basically any thing that may change the rotaion of the attributes in the block.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Not so easy Mark - the current code uses entlast in the reactor call-back function to get the last entity added to the database. When copying/moving/rotating etc, the entlast trick would not work, and so the call-back function would have to get at the entity in another way.

markv Contributor

markv

Posted
  • Author
Posted

Could that be why the code I posted is not working? It does not seem to work no matter what I do. The code above uses

 

 
(defun Attributs_ini(Rea Cde)
(setq dernier_ent (entlast))
)
(defun Attributs_rot_0(Rea Cde / bl js i n)
(cond
((eq (car Cde) "EXECUTETOOL")
(setq js (ssget "_L"))
)
((eq (car Cde) "ROTATE")
(setq js (ssget "_p"))
)
((eq (car Cde) "MIRROR")
(setq js (ssget "_p"))

Lee Mac Grand Master

Lee Mac

Posted
Posted

I hadn't looked at your code actually - I shall experiment with the idea of using the previous selectionset. :)

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok Mark,

 

Give this a shot:

 

;; ZeroAtt                                   ;;
;; Lee Mac  ~  03.03.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;

(defun c:ZeroAtt (/ Reac *ZeroLastEnt*)
 (vl-load-COM)

 (if (setq Reac
       (vl-some
         (function
           (lambda (reactor)
             (if (eq "Zero-Att"
                   (vlr-data reactor)) reactor)))

         (cdar (vlr-reactors :vlr-command-reactor))))

   (if (vlr-added-p Reac)
     
     (vlr-remove Reac)
     (vlr-add Reac))

   (setq Reac
     (vlr-command-reactor "Zero-Att"
       (list
         (cons :vlr-commandWillStart 'GetCommand)
         (cons :vlr-commandEnded     'ZeroAttribs)))))

 (if (vlr-added-p Reac)
   (princ "\n** ZeroAtt Reactor Activated **")
   (princ "\n** ZeroAtt Reactor Deactivated **"))

 (princ))


(defun GetCommand  (Reactor Args)
 (setq *ZeroLastEnt*
   (if (wcmatch (strcase (car Args)) "*COPY,*MIRROR")
     (entlast)))
 
 (princ))


(defun ZeroAttribs (Reactor Args / *error*
                                  GetLocked PutLocked GetEnts dxf
                                        ENT I LOCKED OBJ SS UFLAG)
 (vl-load-com)  

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun GetLocked (/ lst)
   (vlax-for lay (vla-get-Layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
          (setq lst (cons lay lst))
          (vla-put-lock lay :vlax-false)))
   lst)
 

 (defun PutLocked (lst)
   (mapcar
     (function
       (lambda (x)
         (vla-put-lock x :vlax-true))) lst))
 

 (defun GetEnts  (ent)
   (if (setq ent (entnext ent))
     (cons ent (GetEnts ent))))


 (defun dxf (code ent)
   (cdr (assoc code (entget ent))))
 

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       Args (strcase (car Args)))

 (cond (  (and (wcmatch Args "*INSERT,*EXECUTETOOL")
               (setq ent (entlast))

               (eq "AcDbBlockReference"
                   (vla-get-ObjectName
                     (setq obj (vlax-ename->vla-object ent))))
               
               (eq :vlax-true (vla-get-HasAttributes obj)))
        
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked))
        
          (foreach att (append (vlax-invoke obj 'GetAttributes)
                               (vlax-invoke obj 'GetConstantAttributes))
          
            (vla-put-rotation att 0.))
        
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc)))

       (  (or (and (wcmatch Args "*MIRROR,*COPY,*ROTATE")
                   (setq ss  (ssget "_P" '((0 . "INSERT") (66 . 1)))))

              (and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR")
                   (setq ss (cadr (ssgetfirst)))
                   (eq "INSERT" (dxf 0 (ssname ss 0)))
                   (= (dxf 66 (ssname ss 0)) 1)))

          (if *ZeroLastEnt*
            (foreach x (GetEnts *ZeroLastEnt*)
              (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
                (ssadd x ss))))

          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked) i -1)

          (while (setq ent (ssname ss (setq i (1+ i))))
            (setq obj (vlax-ename->vla-object ent))

            (foreach att (append (vlax-invoke obj 'GetAttributes)
                                 (vlax-invoke obj 'GetConstantAttributes))
              
              (vla-put-rotation att 0.)))

          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc))))             

 (princ))

MarcoW Experienced

MarcoW

Posted
Posted

Hello Lee,

 

I like this code very much! Thanks for sharing.

Once I tried ASMI's code but I never got it working.

That must have been because I did something wrong, for sure.

 

When mirroring a block, the attributes stay to zero, nice one.

 

What is the use of the copy function & reactor?

If copied ... the attribute is the same..

 

Is it possible to make some kind of switch in the code to rotate not all attributes to zero but only those who are in a list?

 

Like '("ATT1" "ATT2" "ATT34")...?

 

Thanks allready for the reply,

MarcoW.

Lee Mac Grand Master

Lee Mac

Posted
Posted
What is the use of the copy function & reactor?

If copied ... the attribute is the same..

 

What if a block is copied with attributes that aren't at zero... :)

 

Is it possible to make some kind of switch in the code to rotate not all attributes to zero but only those who are in a list?

 

Like '("ATT1" "ATT2" "ATT34")...?

 

 

Yes, this could be quite easily incorporated :)

MarcoW Experienced

MarcoW

Posted
Posted
What if a block is copied with attributes that aren't at zero... :)

 

Ow yeah... did not see that.

 

 

Yes, this could be quite easily incorporated :)

For some people it is not easy :wink: lime me myself and I.

THe basics I get along pretty good, but this code I cannot understand.

 

If it were up to me I'd say somewhere you collect the attributes.

There needs to be a filter for attribute list.

 

When I search for "how to" I come across this very often:

 


  (if (= (vla-get-TagString a) tag)
    (= (vla-get-TextString a) val))

 

BUt I cannot tell if I am on the right way.

Lee Mac Grand Master

Lee Mac

Posted
Posted

How about this Marco:

 

;; ZeroAtt                                   ;;
;; Lee Mac  ~  03.03.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;

(defun c:ZeroAtt (/ Reac *ZeroLastEnt*)
 (vl-load-COM)

 (if (setq Reac
       (vl-some
         (function
           (lambda (reactor)
             (if (eq "Zero-Att"
                   (vlr-data reactor)) reactor)))

         (cdar (vlr-reactors :vlr-command-reactor))))

   (if (vlr-added-p Reac)
     
     (vlr-remove Reac)
     (vlr-add Reac))

   (setq Reac
     (vlr-command-reactor "Zero-Att"
       (list
         (cons :vlr-commandWillStart 'GetCommand)
         (cons :vlr-commandEnded     'ZeroAttribs)))))

 (if (vlr-added-p Reac)
   (princ "\n** ZeroAtt Reactor Activated **")
   (princ "\n** ZeroAtt Reactor Deactivated **"))

 (princ))


(defun GetCommand  (Reactor Args)
 (setq *ZeroLastEnt*
   (if (wcmatch (strcase (car Args)) "*COPY,*MIRROR")
     (entlast)))
 
 (princ))


(defun ZeroAttribs (Reactor Args / *error*
                                  GetLocked PutLocked GetEnts dxf
                                 ATTLST ENT I LOCKED OBJ SS UFLAG)
 (vl-load-com)


 [color=Red][b](setq AttLst '("TAG1" "TAG2" "TAG3"))  ;; Atts to be Rotated (nil for all)[/b][/color]
 

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun GetLocked (/ lst)
   (vlax-for lay (vla-get-Layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
          (setq lst (cons lay lst))
          (vla-put-lock lay :vlax-false)))
   lst)
 

 (defun PutLocked (lst)
   (mapcar
     (function
       (lambda (x)
         (vla-put-lock x :vlax-true))) lst))
 

 (defun GetEnts  (ent)
   (if (setq ent (entnext ent))
     (cons ent (GetEnts ent))))


 (defun dxf (code ent)
   (cdr (assoc code (entget ent))))
 

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       Args (strcase (car Args)))

 (cond (  (and (wcmatch Args "*INSERT,*EXECUTETOOL")
               (setq ent (entlast))

               (eq "AcDbBlockReference"
                   (vla-get-ObjectName
                     (setq obj (vlax-ename->vla-object ent))))
               
               (eq :vlax-true (vla-get-HasAttributes obj)))
        
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked))
        
          (foreach att (append (vlax-invoke obj 'GetAttributes)
                               (vlax-invoke obj 'GetConstantAttributes))

            (if AttLst
              (if (vl-position
                    (strcase
                      (vla-get-TagString att)) AttLst)

                (vla-put-rotation att 0.))

              (vla-put-rotation att 0.)))
        
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc)))

       (  (or (and (wcmatch Args "*MIRROR,*COPY,*ROTATE")
                   (setq ss  (ssget "_P" '((0 . "INSERT") (66 . 1)))))

              (and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR")
                   (setq ss (cadr (ssgetfirst)))
                   (eq "INSERT" (dxf 0 (ssname ss 0)))
                   (= (dxf 66 (ssname ss 0)) 1)))

          (if *ZeroLastEnt*
            (foreach x (GetEnts *ZeroLastEnt*)
              (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
                (ssadd x ss))))

          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked) i -1)

          (while (setq ent (ssname ss (setq i (1+ i))))
            (setq obj (vlax-ename->vla-object ent))

            (foreach att (append (vlax-invoke obj 'GetAttributes)
                                 (vlax-invoke obj 'GetConstantAttributes))
              
              (if AttLst
                (if (vl-position
                      (strcase
                        (vla-get-TagString att)) AttLst)

                  (vla-put-rotation att 0.))

                (vla-put-rotation att 0.))))

          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc))))             

 (princ))

markv Contributor

markv

Posted
  • Author
Posted

That works good. I added some commands like rotate and move. I am trying to locate the function for the alignment parameter in the help files. I guessed something like GRIP_ALIGN or GRIP_MOVE but they do not seem to work. Any ideas?

MarcoW Experienced

MarcoW

Posted
Posted

@ Lee:

This is really great!!

I would not have found this part:

 
(if AttLst
(if (vl-position
(strcase
(vla-get-TagString att)) AttLst)
(vla-put-rotation att 0.))
(vla-put-rotation att 0.))

Why is the red part twice ? Cannot figure that out...

 

ANyway, nice code.

 

@MarkV:

Nice idea, the GRIP_STRETCH...

I put it like this:

 
(and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR*,GRIP_STRETCH")

 

Now my dynamic blocks (with align parameter) have attributes that rotate after moving. Thanks for the idea you gave to me.

Lee Mac Grand Master

Lee Mac

Posted
Posted 

 
(if AttLst
(if (vl-position
(strcase
(vla-get-TagString att)) AttLst)
(vla-put-rotation att 0.))
(vla-put-rotation att 0.))

Why is the red part twice ? Cannot figure that out...

 

 

I have made the code generic, so that the user can specify the AttLst variable as nil, and all attributes will be processed.

MarcoW Experienced

MarcoW

Posted
Posted

Lee,

 

I have really tried big time (this evening) to modify the code like this:

1. if a block is inserted then rotate attribute TAG1 to 0 degrees.

2. rotate attribute TAG4 either with the same rotation as the block (between 0 and 90 degrees and 270 - 0 degrees) or with the same rotation of the block + 180 degrees (if insert is between 90 and 270 degrees).

 

This is my code, not working:

 

 
;; ZeroAtt                                   ;;
;; Lee Mac  ~  03.03.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;
(defun c:ZeroAtt (/ Reac *ZeroLastEnt*)
 (vl-load-COM)
 (if (setq Reac
       (vl-some
         (function
           (lambda (reactor)
             (if (eq "Zero-Att"
                   (vlr-data reactor)) reactor)))
         (cdar (vlr-reactors :vlr-command-reactor))))
   (if (vlr-added-p Reac)
     
     (vlr-remove Reac)
     (vlr-add Reac))
   (setq Reac
     (vlr-command-reactor "Zero-Att"
       (list
         (cons :vlr-commandWillStart 'GetCommand)
         (cons :vlr-commandEnded     'ZeroAttribs)))))
 (if (vlr-added-p Reac)
   (princ "\n** ZeroAtt Reactor Activated **")
   (princ "\n** ZeroAtt Reactor Deactivated **"))
 (princ))

(defun GetCommand  (Reactor Args)
 (setq *ZeroLastEnt*
   (if (wcmatch (strcase (car Args)) "*COPY,*MIRROR")
     (entlast)))
 
 (princ))

(defun ZeroAttribs (Reactor Args / *error*
                                  GetLocked PutLocked GetEnts dxf
                                 AttLst1 ENT I LOCKED OBJ SS UFLAG)
 (vl-load-com)

 (setq AttLst1 '("[color=red]TAG1[/color]" "TAG2" "TAG3"))  ;; Atts to be Rotated to zero (nil for all)
[b] (setq AttLst2 '("[color=red]TAG4[/color]" "TAG5" "TAG6"))  ;; Atts to be Rotated to rotation of block (nil for all) I copied this string
[/b]  
 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun GetLocked (/ lst)
   (vlax-for lay (vla-get-Layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
          (setq lst (cons lay lst))
          (vla-put-lock lay :vlax-false)))
   lst)
 
 (defun PutLocked (lst)
   (mapcar
     (function
       (lambda (x)
         (vla-put-lock x :vlax-true))) lst))
 
 (defun GetEnts  (ent)
   (if (setq ent (entnext ent))
     (cons ent (GetEnts ent))))

 (defun dxf (code ent)
   (cdr (assoc code (entget ent))))
 
 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))
       Args (strcase (car Args)))
 (cond (  (and (wcmatch Args "*INSERT,*EXECUTETOOL")
 
;coding from here modified
 
 
 (setq ent (entlast)); allready here
 ;;----
[b]  (setq entlist (entget ent)
       rot (cdr (assoc 50 entlist));rotation of block in radians
       rotdgr (/ (* rot 180) pi);rotation of block in degrees
       )[/b]
[b]  (if
   (and
     (> rotdgr 90)
     (< rotdgr 270)
     )
   (setq AttAngle (+ rot pi)); rotate it
   
   (setq AttAngle rot); leave it
   )
[/b]  
 


  
    ;;------
               (eq "AcDbBlockReference"
                   (vla-get-ObjectName
                     (setq obj (vlax-ename->vla-object ent))))
               
               (eq :vlax-true (vla-get-HasAttributes obj)))
        
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked))
        
          (foreach att (append (vlax-invoke obj 'GetAttributes)
                               (vlax-invoke obj 'GetConstantAttributes))
            (if AttLst1
              (if (vl-position
                    (strcase
                      (vla-get-TagString att)) AttLst1)
                (vla-put-rotation att 0.))
              (vla-put-rotation att 0.))
     (if AttLst2
              (if (vl-position
                    (strcase
                      (vla-get-TagString att)) AttLst2)
                (vla-put-rotation att [b]attangle[/b]))
              (vla-put-rotation att [b]attangle[/b]));AttAngle is the problem I guess

     )
        
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc)))
       (  (or (and (wcmatch Args "*MIRROR,*COPY,*ROTATE")
                   (setq ss  (ssget "_P" '((0 . "INSERT") (66 . 1)))))
              (and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR,*GRIP_STRETCH")
                   (setq ss (cadr (ssgetfirst)))
                   (eq "INSERT" (dxf 0 (ssname ss 0)))
                   (= (dxf 66 (ssname ss 0)) 1)))
          (if *ZeroLastEnt*
            (foreach x (GetEnts *ZeroLastEnt*)
              (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
                (ssadd x ss))))
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked) i -1)
          (while (setq ent (ssname ss (setq i (1+ i))))
            (setq obj (vlax-ename->vla-object ent))
            (foreach att (append (vlax-invoke obj 'GetAttributes)
                                 (vlax-invoke obj 'GetConstantAttributes))
              
              (if AttLst1
                (if (vl-position
                      (strcase
                        (vla-get-TagString att)) AttLst1)
                  (vla-put-rotation att 0.))
                (vla-put-rotation att 0.))))
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc))))             
 (princ))

 

I'd like to know what I am doing wrong... the TAG4 does not rotate.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Hi Marco,

 

Perhaps this might be better :)

 

;; ZeroAtt                                   ;;
;; Lee Mac  ~  03.03.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;

(defun c:ZeroAtt (/ Reac *ZeroLastEnt*)
 (vl-load-COM)

 (if (setq Reac
       (vl-some
         (function
           (lambda (reactor)
             (if (eq "Zero-Att"
                   (vlr-data reactor)) reactor)))

         (cdar (vlr-reactors :vlr-command-reactor))))

   (if (vlr-added-p Reac)
     
     (vlr-remove Reac)
     (vlr-add Reac))

   (setq Reac
     (vlr-command-reactor "Zero-Att"
       (list
         (cons :vlr-commandWillStart 'GetCommand)
         (cons :vlr-commandEnded     'ZeroAttribs)))))

 (if (vlr-added-p Reac)
   (princ "\n** ZeroAtt Reactor Activated **")
   (princ "\n** ZeroAtt Reactor Deactivated **"))

 (princ))


(defun GetCommand  (Reactor Args)
 (setq *ZeroLastEnt*
   (if (wcmatch (strcase (car Args)) "*COPY,*MIRROR")
     (entlast)))
 
 (princ))


(defun ZeroAttribs (Reactor Args / *error*
                                  GetLocked PutLocked GetEnts dxf
                ATAG ATTLST BANG ENT I LOCKED OBJ ROTLST SS UFLAG)
 (vl-load-com)


 (setq AttLst '("TAG1"))  ;; Atts to be Rotated (nil for all)

 (setq RotLst '("TAG2"))  ;; Atts to be Rotated to Block Angle
 

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun GetLocked (/ lst)
   (vlax-for lay (vla-get-Layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
          (setq lst (cons lay lst))
          (vla-put-lock lay :vlax-false)))
   lst)
 

 (defun PutLocked (lst)
   (mapcar
     (function
       (lambda (x)
         (vla-put-lock x :vlax-true))) lst))
 

 (defun GetEnts  (ent)
   (if (setq ent (entnext ent))
     (cons ent (GetEnts ent))))
 

 (defun AngleCorrection (lAng)    
   (cond (  (and (> lAng (/ pi 2)) (<= lAng pi))
            (- lAng pi))
         
         (  (and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
            (+ lAng pi))

         (lAng)))
 

 (defun dxf (code ent)
   (cdr (assoc code (entget ent))))  
 

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       Args (strcase (car Args)))

 (cond (  (and (wcmatch Args "*INSERT,*EXECUTETOOL")
               (setq ent (entlast))

               (eq "AcDbBlockReference"
                   (vla-get-ObjectName
                     (setq obj (vlax-ename->vla-object ent))))
               
               (eq :vlax-true (vla-get-HasAttributes obj)))
        
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked)

                bAng (vla-get-Rotation obj))
        
          (foreach att (append (vlax-invoke obj 'GetAttributes)
                               (vlax-invoke obj 'GetConstantAttributes))

            (setq aTag (strcase (vla-get-TagString att)))

            (cond (  (and AttLst
                          (vl-position aTag AttLst))

                     (vla-put-rotation att 0.))

                  (  (and RotLst
                          (vl-position aTag RotLst))

                     (vla-put-rotation att (AngleCorrection bAng)))

                  (t (vla-put-rotation att 0.))))
        
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc)))

       (  (or (and (wcmatch Args "*MIRROR,*COPY,*ROTATE")
                   (setq ss  (ssget "_P" '((0 . "INSERT") (66 . 1)))))

              (and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR")
                   (setq ss (cadr (ssgetfirst)))
                   (eq "INSERT" (dxf 0 (ssname ss 0)))
                   (= (dxf 66 (ssname ss 0)) 1)))

          (if *ZeroLastEnt*
            (foreach x (GetEnts *ZeroLastEnt*)
              (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
                (ssadd x ss))))

          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked) i -1)                

          (while (setq ent (ssname ss (setq i (1+ i))))
            (setq obj (vlax-ename->vla-object ent))

            (setq bAng (vla-get-Rotation obj))

            (foreach att (append (vlax-invoke obj 'GetAttributes)
                                 (vlax-invoke obj 'GetConstantAttributes))

              (setq aTag (strcase (vla-get-TagString att)))
              
              (cond (  (and AttLst
                            (vl-position aTag AttLst))

                       (vla-put-rotation att 0.))

                    (  (and RotLst
                            (vl-position aTag RotLst))

                       (vla-put-rotation att (AngleCorrection bAng)))

                    (t (vla-put-rotation att 0.)))))

          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc))))             

 (princ))

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...