(defun c:Dim2 ( / *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))
)
)
Và của một thành viên alanjt diễn đàn CadTutor
(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)
)
Cuối cùng là code của một bạn bên http://forums.augi.com:
(defun c:dimsum (/ Ss1 i tot val edat)
(princ "Select dim:")
(setq Ss1 (ssget '((0 . "DIMENSION"))))
(setq i 0 tot 0.0)
(while (< i (sslength ss1))
(setq edat (entget (ssname ss1 i)))
(setq val (cdr (assoc 42 edat)))
(setq tot (+ tot val))
(setq i (1+ i))
) ;_ end of while
(princ (strcat "\nTotal: " (rtos tot)))
(princ)
)
Hãy trải nghiệm tiện ích!