[编程交流] 区域命令帮助？

(command "_AREA" pause)
(setq MyArea (getvar "AREA"))

(defun c:GetArea (/ area sset)
      (vl-load-com)
      (ssget);<--- insert filter here
      (setq area 0)
     (vlax-for H (setq sset (vla-get-activeselectionset
                                    (vla-get-activedocument
                                          (vlax-get-acad-object))))
             (setq area (+ (vla-get-area h) area))
             )
      (vla-delete sset)
(alert
      (strcat
            "\nTotal area = "
            (if (or (= (getvar "lunits") 3)
                    (= (getvar "lunits") 4))
                  (strcat
                        (rtos area 2)
                        " sq. in. ("
                        (rtos (/ area 144) 2)
                        " sq. ft.)")
                  (rtos area))))
      )

(defun c:AreaFromPoints (/ PtList i area)
(defun LWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))      
(setq pts (ssget ":L" '((0 . "POINT"))))
(repeat (setq i (sslength pts))
           (setq PtList (cons 
           (cdr (assoc 10 (entget (ssname pts (setq i (1- i)))))) PtList)
           )
     )
     (Lwpoly PtList 1)
     (setq area (vla-get-area (vlax-ename->vla-object (entlast))))
     (entdel (entlast))
     (princ
     (strcat
            "\nTotal area = "
            (if (or (= (getvar "lunits") 3)
                    (= (getvar "lunits") 4))
                  (strcat
                        (rtos area 2)
                        " sq. in. ("
                        (rtos (/ area 144) 2)
                        " sq. ft.)")
                  (rtos area)))
     )
     (princ)
     )

;=======================================================================
;    DYN-Area.Lsp                                    Aug 12, 2011
;    Dynamic Area Calulations
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2011, Fabricated Designs, Inc.")
(princ "\nLoading DYN-Area v1.0 ")
(setq dya_ nil lsp_file "DYN-Area")
;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun dya_smd ()
(SetUndo)
(setq olderr *error*
     *error* (lambda (msg)
               (while (> (getvar "CMDACTIVE") 0)
                      (command))
               (and (/= msg "quit / exit abort")
                    (princ (strcat "\nError: *** " msg " *** ")))
               (and (= (logand (getvar "UNDOCTL")  8)
                    (command "_.UNDO" "_END" "_.U"))
               (dya_rmd))
      dya_var '(("CMDECHO"   . 0) ("COORDS"    . 2)
                ("OSMODE"    . 0) ("SORTENTS"   . 119)
                ("BLIPMODE"  . 0) ("ORTHOMODE"  . 0)
                ("SNAPMODE"  . 0) ("PLINEWID"   . 0)
                ("ELEVATION" . 0) ("THICKNESS"  . 0)
                ("CECOLOR"   . "BYLAYER")
                ("CELTYPE"   . "BYLAYER")))
(foreach v dya_var
  (and (getvar (car v))
       (setq dya_rst (cons (cons (car v) (getvar (car v))) dya_rst))
       (setvar (car v) (cdr v))))
(princ))
;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun dya_rmd ()
 (setq *error* olderr)
 (foreach v dya_rst (setvar (car v) (cdr v)))
 (command "_.UNDO" "_END")
 (prin1))
;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
     (command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
     (command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")  8)
     (command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
;************ Main Program ***************************************
(defun dya_ (/ olderr dya_var dya_rst sp pl np tl)
 (dya_smd)
 (initget 1)
 (setq sp (getpoint "\n1st Point:   "))
 (setq pl (list sp))
 (while (setq np (getpoint sp "\nNext Point - (Enter to Exit):   "))
        (setq pl (cons np pl)
              tl pl
              sp np)
        (command "_.PLINE")
          (foreach p pl (command p))
        (command "_CL")
        (command "_.AREA" "_E" (entlast))
        (command "_.ERASE" (entlast) "")
        (princ (strcat " = " (rtos (getvar "AREA"))))
        (redraw)
        (repeat (1- (length tl))
                (grdraw (nth 0 tl) (nth 1 tl) 2 1)
                (setq tl (cdr tl)))
        (grdraw (nth 0 tl) np 2 1))
 (redraw)
 (repeat (1- (length pl))
         (grdraw (nth 0 pl) (nth 1 pl) 7 1)
         (setq pl (cdr pl)))
 (grdraw (nth 0 pl) sp 7 1)
 (princ (strcat " = " (rtos (getvar "AREA"))))
 (dya_rmd))
;************ Load Program ***************************************
(defun C:DYN-Area () (dya_))
(if dya_ (princ "\nDYN-Area Loaded\n"))
(prin1)
;|================== End Program =======================================

(mapcar '(lambda (a b) (grdraw a b 7))
             (setq lst (if (eq pt "Undo")
                         (cdr lst)
                         (cons pt lst)
                       )
             )
             (cons (last lst) lst)
     )

(defun c:test (/ pt1 pt2 pt3 LxW str)
     (setq pt1 (getpoint "\nLower Left Corner:")
           pt3 (getcorner pt1 "\nLower Upper Rigbt  Corner:"))
     (setq pt2 (list (car pt1) (cadr pt3) 0.0))
     (setq LxW (list (distance pt1 pt2) (distance pt2 pt3)))
     (setq str 
     (if (or (= (getvar "lunits") 3)
                    (= (getvar "lunits") 4))
                  (strcat                        
                          (rtos (/ (apply '* Lxw) 144) 2)
                        " sq. ft.")
                  (strcat (rtos (apply '* Lxw)) " m²")
         )
           )
     (command "_text" "_Justify" "_center" "_non" (mapcar (function (lambda (a b) (/ (+ a b) 2.))) pt1 pt3)
           (getvar 'TextSize) 0 str)
)

(defun c:test (/ str pt)
(setq str
                  (if (or (= (getvar "lunits") 3)
                          (= (getvar "lunits") 4))
                        (strcat
                              (rtos (/ (getvar "AREA") 144) 2)
                              " sq. ft.")
                        (strcat (getvar "AREA") " m²")
                        )
             )
     (setq pt (getpoint "\n Select insertion point : "))
     (command "_text" "_Justify" "_center" "_non" pt
           (getvar 'TextSize) 0 str)
)