Author Topic: Tool Palette Rector  (Read 939 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1449
Tool Palette Rector
« on: March 17, 2023, 01:45:26 PM »
First the background:
I have a block that I need to have as an annotative block, it is called Outlet in the attached drawing.

I need the entire block to scale up and down with the scale of the drawing, unfortunately this prevents the text from staying horizontal when using the align parameter.

I am able to manually adjust the rotation of the text, but I would like to make it automatic to make the text horizontal every time automatically.

I can find reactors that react to the insert command that I think I could modify, but first off they interfere with the automatic alignment parameter in the block and I will be inserting the blocks using the tool palette.

Can anyone point me in the right direction here? I would greatly appreciate it. I am also going to keep at it while waiting on a response, but any assistance is also appreciated.

cmwade77

  • Swamp Rat
  • Posts: 1449
Re: Tool Palette Rector
« Reply #1 on: March 20, 2023, 05:24:13 PM »
I think I have something that works finally.

Code: [Select]
(vl-load-com)

;*******************************************************
(vlr-command-reactor
  "Fix Text"
  '((:vlr-commandEnded . InsertFix))
)

;*******************************************************
(defun InsertFix (calling-reactor endcommandInfo / thecommandend SS)
  (setq thecommandend (nth 0 endcommandInfo))
  (if (or (= thecommandend "EXECUTETOOL") (= thecommandend "INSERT"))

    (progn
      (setq SS (ssadd))
      (ssadd (entlast) SS)
      (FixBlockText SS)
    ) ;progn
  ) ;if
  (princ)
) ;defun

(defun c:FixBlockText ()
  (FixBlockText nil)
)
(defun FixBlockText (SS / SS CT BLK OBJ BROTATION TextAngle BlkName doc cAngle tAngle Changed NeedsChanging WasNil)
 
    ;; Get Dynamic Block Property Value  -  Lee Mac
    ;; Returns the value of a Dynamic Block property (if present)
    ;; blk - [vla] VLA Dynamic Block Reference object
    ;; prp - [str] Dynamic Block property name (case-insensitive)

    (defun LM:getdynpropvalue ( blk prp )
        (setq prp (strcase prp))
        (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
            (vlax-invoke blk 'getdynamicblockproperties)
        )
    )
 
  ;; Set Dynamic Block Properties  -  Lee Mac
  ;; Modifies values of Dynamic Block properties using a supplied association list.
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; lst - [lst] Association list of ((<Property> . <Value>) ... )
  ;; Returns: nil
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (LM:StartUndo Doc)
  (defun RtD (r) (* 180.0 (/ r pi)))
  ; converts degrees to radians
  (defun DtR (d) (* pi (/ d 180.0)))
  (defun LM:setdynprops ( blk lst / itm )
      (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst))
      (foreach x (vlax-invoke blk 'getdynamicblockproperties)
          (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst))
              (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x))))
          )
      )
  )
  (IF (= SS NIL)
    (SETQ WasNil T)
  )
  (while (not SS)
    (setq SS (ssget "_X" '((0 . "INSERT"))))
  )
  (repeat (setq CT (sslength SS))
    (setq BLK (ssname SS (setq CT (1- CT)))
          Obj (vlax-ename->vla-object BLK)
          BlkName (strcase (LM:BlockName Obj))
    )
    (if (= BlkName "OUTLET")
      (progn
        (setq BROTATION (dtr (* (rtd (vla-get-rotation Obj)) -1))
              TextAngle (list (cons "Circuit Angle" BROTATION)
                              (cons "Type Angle" BROTATION)
                        )
        )
        (setq cAngle (LM:getdynpropvalue Obj "Circuit Angle")
              tAngle (LM:getdynpropvalue Obj "Type Angle")
        )
        (if (and cAngle (/= Changed 2) (/= cAngle BROTATION))
          (setq NeedsChanging T)
        )
        (if (and tAngle (/= Changed 2) (/= tAngle BROTATION))
          (setq NeedsChanging T)
        )
        (if NeedsChanging
          (progn
            (LM:setdynprops Obj TextAngle)
            (setq Changed T)
          )
        )
      )
    )
  )
  (if (and Changed WasNil)
    (alert (strcat "Text in block(s) with name <" BlkName "> have changed rotation, please check text location for all instances of this block."))
  )
  (LM:EndUndo doc)
)


cmwade77

  • Swamp Rat
  • Posts: 1449
Re: Tool Palette Rector
« Reply #2 on: March 23, 2023, 12:50:00 PM »
While the above code was indeed functional, it required creating rotation parameters for every attribute, I actually asked ChatGPT to write me a routine that would automatically rotate attributes to horizontal for blocks with a specific name and for attributes whose tag does not begin with NR_

It actually did a pretty good job in the matter of seconds, I only had to make one minor correction and made a few minor changes to handle selecting all blocks or just the last inserted block.

Code: [Select]
(vlr-command-reactor
  "Fix Text"
  '((:vlr-commandEnded . InsertFix))
)




;*******************************************************
(defun InsertFix (calling-reactor endcommandInfo / thecommandend SS)
  (setq thecommandend (nth 0 endcommandInfo))
  (if (or (= thecommandend "EXECUTETOOL") (= thecommandend "INSERT"))

    (progn
      (setq SS (ssadd))
      (ssadd (entlast) SS)
      (FixBlockText SS)
    ) ;progn
  ) ;if
  (princ)
) ;defun

(defun c:FixBlockText ()
  (FixBlockText nil)
)

(defun FixBlockText (SS / ss ent i atts obj BlockNamesToFix Changed WasNil) ;Written by ChatGPT with minor changes by Chris Wade
  (if (not SS);Added code to check if we should apply to all blocks or if there was just a selection.
    (progn
      (setq WasNil T
            ss (ssget "_X" (list (cons 0 "INSERT") (cons 66 1)))
      )
    )
  )
  (if ss
    (progn
      (setq BlockNamesToFix '("OUTLET" "DEVICE" "SWITCH" "WIRE")) ; Make sure all names are typed in all capital letters
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i)
              Obj (vlax-ename->vla-object ent)
              BlkName (strcase (LM:BlockName Obj))
        )
        (if (member BlkName BlockNamesToFix)
          (progn
            (setq i (1+ i))
            (setq atts (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes))
            (foreach att atts
              (if (/= 0 (vl-string-search "NR_" (vla-get-TagString att)));Had to make a minor adjustment to actually get the tag name, as it had errors.
                (progn
                  (vlax-put-property att 'Rotation 0)
                )
              )
            )
          )
        )
      )
      (princ "\nAttributes rotated to 0 degrees for all selected blocks.")
    )
    (princ "\nNo blocks found.")
  )
  (if (and Changed WasNil); Added alert if applying to all blocks
    (alert (strcat "Text in block(s) with name have changed rotation, please check text location for all instances of all blocks."))
  )
  (princ)
)

danAllen

  • Newt
  • Posts: 135
Re: Tool Palette Rector
« Reply #3 on: March 23, 2023, 01:31:28 PM »
... I actually asked ChatGPT to write me a routine

I'm curious, could you share the prompt and code it returned? Was it from scratch or a request to modify your routine?