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

Lisp Copy tăng số trong AutoCAD | AutoLISP That la don gian

Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản       Thông tin thêm: 👉👉👉

Popular Posts