flyfox1047 发表于 2013-12-1 23:16:03

获取多个对象的累计长度之和

命令bomlengths
获取多个对象的累计长度之和

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

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

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

(setq olderr*error*
      restore undox
      *error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(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
      (listcurve
      (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* olderroldcmdecho      %l      %t
               sset    %i      en      ed      p1      p2
               ot      a1      a2      r
                )
(defun errexit (s)
    (princ)
    (restore)
)

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

(setq olderr*error*
      restore undox
      *error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(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:bomlengths ()
(initget "Lines Arcs Polylines Splines ALL")
(setq ans (getkword
            "Enter an option : "
            )
)
(cond
    ((= ans "Lines") (c:bom_lines))
    ((= ans "Arcs") (c:bom_arcs))
    ((= ans "Polylines") (c:bom_polylines))
    ((= ans "Splines") (c:bom_splines))
    (t
   (bom-code '((-4 . "<OR")
               (0 . "LINE")
               (0 . "ARC")
               (0 . "POLYLINE")
               (0 . "LWPOLYLINE")
               (0 . "SPLINE")
               (-4 . "OR>")
                )
   )
    )
)
(princ)
)

(defun c:bom_lines ()
(bom-code '((0 . "LINE")))
(princ)
)

(defun c:bom_arcs ()
(bom-code '((0 . "ARC")))
(princ)
)

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

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

434939575 发表于 2014-2-18 14:51:05

这么多子函数学习了！

l18c19 发表于 2014-2-19 09:02:20

加载后，出现：未知命令“BOMLENGTHS”。按 F1 查看帮助。

yoyoho 发表于 2014-2-26 16:03:07

感谢 flyfox1047 分享!

yiqisese 发表于 2014-4-3 13:14:02

感谢分享!    感谢分享!
页: [1]
查看完整版本: 获取多个对象的累计长度之和