(setq sel-text (ssget "X" '((0 . "TEXT") (410 . "Model")))
new-scale (vla-get-CustomScale obj-notif)
text-height (* (getvar "textsize") (/ 1 new-scale))
i 0)
(while (setq txt-str (ssname sel-text i))
(setq txt-str (vlax-ename->vla-object txt-str))
(if
(and (vlax-write-enabled-p txt-str)
(can-use? (vla-get-Layer txt-str))
(/= (vla-get-height txt-str) text-height))
(vla-put-Height txt-str text-height))
(setq i (1+ i))))
;;;Listing 21.1. Function that processes the texts.
(defun vport-callback (obj-notif obj-react lis-param)
(if
(and (zerop (getvar "CMDACTIVE"))
(vlax-read-enabled-p obj-notif)
(= (getvar "CTAB") (car (vlr-data obj-react))))
(process-texts obj-notif)))
;;;Listing 21.2. Callback function triggered by changes in the viewport.
(defun command-end-callback (obj-react lis-param / vport-obj)
(setq vport-obj (vlax-ename->vla-object
(handent (cadr (vlr-data obj-react)))))
(if
(and (= (car lis-param) "PSPACE")
(vlax-read-enabled-p vport-obj))
(process-texts vport-obj)))
;;;Listing 21.3. Callback function triggered on concluding a command.
(defun vport-reactor (vport)
(vlr-pers
(vlr-object-reactor
(list vport)
(list (getvar "CTAB") (vla-get-Handle vport))
'((:VLR-objectClosed . vport-callback)))))
;;;Listing 21.4. Creating the Object reactor.
(defun command-reactor (vport)
(vlr-pers
(vlr-command-reactor
(list (getvar "CTAB") (vla-get-handle vport))
'((:vlr-commandEnded . command-end-callback)))))
;;;Listing 21.5. Creating the Command reactor.
(defun C:AUTO-SCALE (/ viewport vport-obj)
(cond
((/= (getvar "CTAB") "Model")
(prompt "\nSelect viewport for text auto-scaling:\n ")
(while (not (setq viewport (ssget "_:S" '((0 . "VIEWPORT"))))))
(setq vport-obj (vlax-ename->vla-object
(ssname viewport 0)))
(if (not (owner? vport-obj))
(progn (vport-reactor vport-obj)
(command-reactor vport-obj))
(alert "This viewport already owns reactors.")))
(t
(alert "This command is only valid \nin PaperSpace."))))
;;;Listing 21.6. C:AUTO-SCALE. User interface for creating the reactors.
(defun owner? (obj / reactors)
(if
(setq reactors (mapcar 'cadr
(vlr-reactors :VLR-Object-Reactor)))
(apply 'or
(mapcar
'(lambda (x)
(if (member obj (vlr-owners x))
t))
reactors))))
;;;Listing 21.7. Function that determines if an object owns reactors.
;;;(vl-load-com)
;;;(load "reactor-functions"
;;; "REACTOR-FUNCTIONS not found")
;;;(autoload "scale-text" '("AUTO-SCALE"))
;;;Listing 21.8. Code to include in ACADDOC.LSP.
;|
(defun reaction (reactor params)
(princ (vlr-data reactor))
(princ " | ")
(princ (vlr-current-reaction-name))
(princ " | ")
(princ params)
(princ "\n"))
;;;Listing 21.9. Callback function that reports on events.
(defun reaction-obj (obj reactor params)
(princ (vlr-data reactor))
(princ " | ")
(princ (vlr-current-reaction-name))
(princ " | ")
(princ params)
(princ "\n"))
;;;Listing 21.10. Object reactor callback function.
(vlr-acdb-reactor "DataBase"
'((:vlr-objectAppended . reaction)
(:vlr-objectUnAppended . reaction)
(:vlr-objectReAppended . reaction)
(:vlr-objectOpenedForModify . reaction)
(:vlr-objectModified . reaction)
(:vlr-objectErased . reaction)
(:vlr-objectUnErased . reaction)))
;;;Listing 21.11. Creation of the Database reactor.
(vlr-editor-reactor
"Editor"
'((:vlr-beginClose . reaction)
(:vlr-beginDxfIn . reaction)
(:vlr-abortDxfIn . reaction)
(:vlr-dxfInComplete . reaction)
(:vlr-beginDxfOut . reaction)
(:vlr-abortDxfOut . reaction)
(:vlr-dxfOutComplete . reaction)
(:vlr-databaseToBeDestroyed . reaction)
(:vlr-unknownCommand . reaction)
(:vlr-commandWillStart . reaction)
(:vlr-commandCancelled . reaction)
(:vlr-commandEnded . reaction)
(:vlr-commandFailed . reaction)
(:vlr-lispWillStart . reaction)
(:vlr-lispEnded . reaction)
(:vlr-lispCancelled . reaction)
(:vlr-beginDwgOpen . reaction)
(:vlr-endDwgOpen . reaction)
(:vlr-dwgFileOpened . reaction)
(:vlr-beginSave . reaction)
(:vlr-sysVarWillChange . reaction)
(:vlr-sysVarChanged . reaction)))
;;;Listing 21.12. Creation of the Editor reactor.
(defun C:VLR-OBJECT ()
(setq obj (vlax-ename->vla-object (car (entsel))))
(vlr-object-reactor (list obj)
"Objeto"
'((:vlr-cancelled . reaction-obj)
(:vlr-copied . reaction-obj)
(:vlr-erased . reaction-obj)
(:vlr-unerased . reaction-obj)
(:vlr-goodbye . reaction-obj)
(:vlr-openedForModify . reaction-obj)
(:vlr-modified . reaction-obj)
(:vlr-subObjModified . reaction-obj)
(:vlr-modifyUndone . reaction-obj)
(:vlr-modifiedXData . reaction-obj)
(:vlr-unappended . reaction-obj)
(:vlr-reappended . reaction-obj)
(:vlr-objectClosed . reaction-obj))))
;;;Listing 21.13. Function to link an informative object reactor.
No comments:
Post a Comment