[编程交流] 尺寸值自动求和

(defun c:Dims2Field ( / *error* spc doc pt uFlag ss ids )
 (vl-load-com)
 ;; © Lee Mac 2010
 (defun *error* ( msg )
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )  
 (if (and (ssget '((0 . "*DIMENSION")))
          (setq pt (getpoint "\nPick Point for Field: ")))
   (progn
     (setq uFlag (not (vla-StartUndoMark doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids
         (cons (GetObjectID obj doc) Ids)
       )
     )
     (vla-delete ss)
     (vla-AddMText spc (vlax-3D-point pt) 0.
       (if (= 1 (length Ids))
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids) ">%).Measurement \\f "%lu6">%")
         (strcat "%<\\AcExpr"
           (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Measurement >% +")
           ">%).Measurement >% \\f "%lu6">%"
         )
       )
     )
     
     (setq uFlag (vla-EndUndomark doc))
   )
 )
 (princ)
)
(defun lst->str ( lst d1 d2 )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
   (strcat d1 (car lst))
 )
)
(defun GetObjectID ( obj doc )
 ;; © Lee Mac 2010
 (if
   (eq "X64"
     (strcase
       (getenv "PROCESSOR_ARCHITECTURE")
     )
   )
   (vlax-invoke-method
     (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
   )
   (itoa (vla-get-Objectid obj))
 )
)

(defun c:DimSum (/ ss)
 ;; Alan J. Thompson
 (if (setq ss (ssget '((0 . "DIMENSION"))))
   ((lambda (v)
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (or (wcmatch (vla-get-objectname x) "*Angular*") (setq v (+ v (vla-get-measurement x))))
      )
      (vla-delete ss)
      (or (zerop v) (alert (strcat "Total: " (rtos v))))
    )
     0.
   )
 )
 (princ)
)