[编程交流] Windows维度

(defun c:Test ( / *error* doc enm obj ptBot ptTop)
 (defun *error* (msg)
   (vla-endundomark doc)
 )
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (while
   (and
     (setq enm (car (entsel "\nSelect mtext: ")))
     (or
       (= "AcDbMText" (vla-get-objectname (setq obj (vlax-ename->vla-object enm))))
       (prompt "\nError: not an mtext ")
     )
     (setq ptBot (getpoint "\nBottom of frame: "))
     (setq ptTop (getpoint ptBot "\nTop of frame: "))
     (setq ptBot (trans ptBot 1 0)) ; in WCS.
     (setq ptTop (trans ptTop 1 0))
   )
   (vla-put-textstring
     obj
     (strcat ; "WS=11.11\\PWH=22.22"
       "WS=" (rtos (caddr ptBot) 2 2)
       "\\P"
       "WH=" (rtos (- (caddr ptTop) (caddr ptBot)) 2 2)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

(defun c:Test ( / doc enm obj ptFloor ptBot ptTop)
(command "UCS" "world")
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (while
   (and
     (setq enm (car (entsel "\nSelect mtext or Enter to quit: ")))
     (or
       (= "AcDbMText" (vla-get-objectname (setq obj (vlax-ename->vla-object enm))))
       (prompt "\nError: not an mtext ")
     )
  (setq ptFloor (getpoint "\nFloor level: "))
     (setq ptBot (getpoint "\nBottom of frame: "))
     (setq ptTop (getpoint ptBot "\nTop of frame: "))
     (setq ptFloor (trans ptFloor 1 0))
  (setq ptBot (trans ptBot 1 0)) 
     (setq ptTop (trans ptTop 1 0))
   )
   (vla-put-textstring
     obj
     (strcat ; "WS=11.11\\PWH=22.22"
       "WS=" (rtos (/ (- (caddr ptBot) (caddr ptFloor)) 1000.) 2 2)
       "\\P"
       "WH=" (rtos (/ (- (caddr ptTop) (caddr ptBot)) 1000.) 2 2)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
 
 (command "UCS" "_p")
)