June 17, 2013

Cộng các đường dim kích thước trong AutoCAD

Trước tiên là lisp của ban Lee Mac, một "cao thủ" trong giới võ lâm:
(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!

Featured Post

Tổng hợp nút giao trong Quy hoạch Giao thông | Quy hoạch LDT | AutoLISP Reviewer

Ngày hôm nay AutoLISP Reviewer xin giới thiệu với các bạn một chức năng mới của Quy hoạch LDT là tổng hợp nút giao THNG Chức năng này giúp t...

Popular Posts