TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: cmwade77 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.
-
I think I have something that works finally.
(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)
)
-
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.
(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)
)
-
... 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?