AutoCAD uzunlukları pencerede gösterme lispi - Metraj Lispi

Lispin amacı

line uzunluklarını ölçer
polyline çizgilerin uzunluklarını ölçer
spline çizgi uzunluklarını ölçer
circle daire çevresini ölçer
arc (yay) cevre uzunluğunu ölçer
uzunluk değeri olan nesnelerin uzunluğunu ölçer.

Autocad lisp kodlar

(defun dxf (n ed) (cdr (assoc n ed)))

(defun bom-code (ssfilter        /       errexit undox   restore
                 *error* olderr  oldcmdecho      %l      %t
                 sset    %i      en      ed      p1      p2
                 ot      a1      a2      r
                )
  (defun errexit (s)
    (princ)
    (restore)
  )

(defun undox ()
    (if command-s
      (command-s "._undo" "_E")
      (command "._undo" "_E")
    )
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )

(setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if command-s
    (command-s "._UNDO" "_BE")
    (command "._UNDO" "_BE")
  )
  (setq %i 0
        %t 0
  )
  (vl-load-com)
  (setq sset (ssget ssfilter))
  (if sset
    (progn
      (princ "\nLengths:")
      (repeat (sslength sset)
        (setq en (ssname sset %i))
        (setq ed (entget en))
        (setq ot (dxf 0 ed))
        (setq curve (vlax-ename->vla-object en))
        (if (vl-catch-all-error-p
              (setq len (vl-catch-all-apply
                          'vlax-curve-getDistAtParam
                          (list curve
                                (vl-catch-all-apply
                                  'vlax-curve-getEndParam
                                  (list curve)
                                )
                          )
                        )
              )
            )
          nil
          len
        )
        (setq %l len)

(setq %i (1+ %i)
              %t (+ %l %t)
        )
        (terpri)
                                        ;(princ %l )
        (princ (rtos %l (getvar "lunits") (getvar "luprec")))
      )
      (princ "\nTotal = ")
                                        ;(princ %t)
      (princ (rtos %t (getvar "lunits") (getvar "luprec")))
      (textpage)
    )
  )
  (setq sset nil)
  (restore)
)

(defun bom-code-old (ssfilter        /       errexit undox   restore
                     *error* olderr  oldcmdecho      %l      %t
                     sset    %i      en      ed      p1      p2
                     ot      a1      a2      r
                    )
  (defun errexit (s)
    (princ)
    (restore)
  )

(defun undox ()
    (if command-s
      (command-s "._undo" "_E")
      (command "._undo" "_E")
    )
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )

(setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if command-s
    (command-s "._UNDO" "_BE")
    (command "._UNDO" "_BE")
  )
  (setq %i 0
        %t 0
  )
  (setq sset (ssget ssfilter))
  (if sset
    (progn
      (princ "\nLengths:")
      (repeat (sslength sset)
        (setq en (ssname sset %i))
        (setq ed (entget en))
        (setq ot (dxf 0 ed))
        (cond
          ((= ot "LINE")
           (setq p1 (dxf 10 ed)
                 p2 (dxf 11 ed)
                 %l (distance p1 p2)
           )
          )
          ((= ot "ARC")
           (setq a1 (dxf 50 ed)
                 a2 (dxf 51 ed)
                 r  (dxf 40 ed)
                 %l (* r (abs (- a2 a1)))
           )
          )
          (t
           (command "._area" "_obj" en)
           (setq %l (getvar "perimeter"))

)
        )
        (setq %i (1+ %i)
              %t (+ %l %t)
        )
        (terpri)
        (princ %l)
      )
      (princ "\nTotal = ")
      (princ %t)
      (textpage)
    )
  )
  (setq sset nil)
  (restore)
)

(defun c:UZUNLUK-PEN ()
  (initget "Lines Circles Arcs Ellipses Polylines Splines ALL"
  )
  (setq ans
         (getkword
           "Enter an option [Lines/Circles/Arcs/Ellipses/Polylines/Splines] : "
         )
  )
  (cond
    ((= ans "Lines") (c:bom_lines))
    ((= ans "Circles") (c:bom_circles))
    ((= ans "Arcs") (c:bom_arcs))
    ((= ans "Ellipses") (c:bom_ellipses))
    ((= ans "Polylines") (c:bom_polylines))
    ((= ans "Splines") (c:bom_splines))
    (t
     (bom-code '((-4 . "<OR")
                 (0 . "LINE")
                 (0 . "CIRCLE")
                 (0 . "ARC")
                 (0 . "ELLIPSE")
                 (0 . "POLYLINE")
                 (0 . "LWPOLYLINE")
                 (0 . "SPLINE")
                 (-4 . "OR>")
                )
     )
    )
  )
  (princ)
)

(defun c:UZUNLUK-PEN-LINES ()
  (bom-code '((0 . "LINE")))
  (princ)
)

(defun c:UZUNLUK-PEN-CIRCLES ()
  (bom-code '((0 . "CIRCLE")))
  (princ)
)

(defun c:UZUNLUK-PEN-ARCS ()
  (bom-code '((0 . "ARC")))
  (princ)
)

(defun c:UZUNLUK-PEN-ELLIPSE ()
  (bom-code '((0 . "ELLIPSE")))
  (princ)
)

(defun c:UZUNLUK-PEN-POLYLINE ()
  (bom-code '((-4 . "<OR")
              (0 . "POLYLINE")
              (0 . "LWPOLYLINE")
              (-4 . "OR>")
             )
  )
  (princ)
)

(defun c:UZUNLUK-PEN-SPLINE ()
  (bom-code '((0 . "SPLINE")))
  (princ)
)

(princ)

Lisp dosyasını oluşturmayı ve AutoCAD"e yüklemeyi bilmiyorsanız. Lispi bilgisayara kaydetmek ve AutoCAD"e yüklemek için AutoCAD lisp dosyasını kaydetme ve yükleme nasıl yapılır yazısını okuyun