[编程交流] '警报#039；带foc的盒子

(acet-ui-txted  
 ( (lambda ( / s i ) (repeat 100 (setq s (strcat (cond (s (strcat s "\r\n"))("")) (itoa (setq i (1+ (cond (i)(0))))))))) )
 "Caption" "Note"
)

(defun C:test nil
 (
   (lambda (txt / cad spc o ll ur)
     (and
       (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (setq cad (vlax-get-acad-object))))))
       (setq o (vla-AddMText spc (vlax-3d-point '(0. 0. 0.)) 1 txt))
       (progn
         (vla-GetBoundingBox o 'll 'ur)
         (vla-ZoomWindow cad ll ur)
         (vla-ZoomScaled cad 0.5 acZoomScaledRelative)
         (while (not (grread)))
         (repeat 2 (vla-ZoomPrevious cad))
         (vl-catch-all-apply 'vla-Delete (list o))
       )
     )
   )
   "Hello\nWorld!"
 )
)

(defun c:MINIQUANTUMPANELAAN (/                     itemarea              itemperimeter         itemlinelength
              itemarclength         itemsplinelength      itemregionperimeter   itemcircumference
              itemsplineperimeter   itemplineperimeter    itemplinelength       itemtracelength
              itemarclength         itemellipselength a b c d p1 p2 itemlength tarea tperim tlength
             )
 (vl-load-com)
 (defun *oo_object_modification* (objreactor objectsmodified)
   (setq selected_objects (vla-get-pickfirstselectionset
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
   )
   (setq itemarea 0
         itemperimeter 0
         itemlinelength 0
         itemarclength 0
         itemsplinelength 0
         itemregionperimeter 0
         itemcircumference 0
         itemsplineperimeter 0
         itemplineperimeter 0
         itemplinelength 0
         itemtracelength 0
         itemarclength 0
         itemellipselength 0
   )
   ;AREA
   (vlax-for n selected_objects 
     (if (vlax-property-available-p n 'area)
       (if (eq (vla-get-objectname n) "AcDbRegion")
         (setq itemarea (+ itemarea (vla-get-area n)))
         (if (vlax-curve-isclosed n)
           (setq itemarea (+ itemarea (vla-get-area n)))
         )
       )
     )
     ;;CIRCLE
     (if (vlax-property-available-p n 'circumference)
       (setq itemcircumference (+ itemcircumference (vla-get-circumference n)))
     )
     ;;SPLINE
     (if (eq (vla-get-objectname n) "AcDbSpline")
       (if (vlax-curve-isclosed n)
         (setq itemsplineperimeter (+ itemsplineperimeter
                                      (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                   )
         )
         (setq itemsplinelength (+ itemsplinelength
                                   (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                )
         )
       )
     )
     ;;REGION
     (if (eq (vla-get-objectname n) "AcDbRegion")
       (setq itemregionperimeter (+ itemregionperimeter (vla-get-perimeter n)))
     )
     ;;PLINE
     (if (or (eq (vla-get-objectname n) "AcDb2dPolyline")
             (eq (vla-get-objectname n) "AcDbPolyline")
         )
       (if (vlax-curve-isclosed n)
         (setq itemplineperimeter (+ itemplineperimeter
                                     (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                  )
         )
         (setq itemplinelength (+ itemplinelength
                                  (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                               )
         )
       )
     )
     ;;LINE
     (if (eq (vla-get-objectname n) "AcDbLine")
       (setq itemlinelength (+ itemlinelength (vla-get-length n)))
     )
     ;;ARC
     (if (eq (vla-get-objectname n) "AcDbArc")
       (setq itemarclength (+ itemarclength (vla-get-arclength n)))
     )
     (if (eq (vla-get-objectname n) "AcDbEllipse")
       (setq itemellipselength (+ itemellipselength
                                  (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                               )
       )
     )
     ;;TRACE
     (if (eq (vla-get-objectname n) "AcDbTrace")
       (progn (setq plist (vlax-safearray->list
                            (vlax-variant-value (vla-get-coordinates n))
                          )
              )
              (setq a (list (nth 0 plist) (nth 1 plist) (nth 2 plist)))
              (setq b (list (nth 3 plist) (nth 4 plist) (nth 5 plist)))
              (setq c (list (nth 6 plist) (nth 7 plist) (nth 8 plist)))
              (setq d (list (nth 9 plist) (nth 10 plist) (nth 11 plist)))
              (setq p1 (polar a (angle a b) (/ (distance a b) 2.0)))
              (setq p2 (polar c (angle c d) (/ (distance c d) 2.0)))
              (setq itemtracelength (+ itemtracelength (distance p1 p2)))
       )
     )
   )
   ;;_end vlax-for
   (setq itemperimeter (+ itemcircumference
                          itemsplineperimeter
                          itemregionperimeter
                          itemplineperimeter
                       )
   )
   (setq itemlength (+ itemplinelength itemsplinelength itemlinelength itemtracelength itemarclength itemellipselength)
   )
   (setq tarea (rtos itemarea 2 3))
   (setq HBTotal (+ itemperimeter itemlength))
   (setq HBT (rtos HBTotal 2 3))
   (setq tperim (rtos itemperimeter 2 )
   (setq tlength (rtos itemlength 2 )
   (acet-ui-status (strcat "Totaal oppervlak:                " tarea " m2" "\n"
                    "Totaal lengte:                        " HBT " m1") "Mini QuantumPanel"
   )
 )
 ;;OBJECT SELECTION
 (if oo_object_modification
   (progn (vlr-remove oo_object_modification)
          (setq oo_object_modification nil)
   )
 )
 (setq oo_object_modification
        (vlr-miscellaneous-reactor
          nil
          '((:vlr-pickfirstmodified . *oo_object_modification*))
        )
 )
 ;;Command ended  
 (if oo_object_modification_action
   (progn (vlr-remove oo_object_modification_action)
          (setq oo_object_modification_action nil)
   )
 )
 (setq oo_object_modification_action
        (vlr-command-reactor nil
                             '((:vlr-commandended . *oo_object_modification*)
;(:vlr-commandcancelled . *oo_object_modification_CANCEL*))
                              )
        )
 )
)
(defun c:MINIQUANTUMPANELUIT ()
 (if oo_object_modification_action
   (progn (vlr-remove oo_object_modification_action)
          (setq oo_object_modification_action nil)
   )
 )
 (if oo_object_modification
   (progn (vlr-remove oo_object_modification)
          (setq oo_object_modification nil)
   )
 )
)