Translate to: |
|||||||
Обратная связь | Новости САПР | Программы | Документация | Полезные советы | Обзорные статьи | ||
Заказ и разработка | Каталог САПР | САПР-конференция | Библиотека ГОСТов | Наши соавторы | Коммерческое ПО |
;;;---------------------------------------------------------------------------; ;;; ;;; bomlengths.lsp ;;; ;;; Проверено на AutoCAD 2000, 2004, 2005, 2008 ;;; должна так же работать на более старых версиях с небольшими изменениями: ;;; переименовать bom-code-old на bom-code ;;; ;;;---------------------------------------------------------------------------; ;;; Описание: ;;; ;;; Получение общей длины группы объектов. ;;; c:bomlengths - длина линий, дуг, полилиний и сплайнов по отдельности и общая. ;;; c:bom_lines - длина линий и общая. ;;; c:bom_arcs - длина дуг и общая. ;;; c:bom_polylines - длина полилиний и общая. ;;; c:bom_splines - длина сплайнов и общая. ;;;---------------------------------------------------------------------------; (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 () (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 (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) ) ) (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 () (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) ) ) (restore) ) (defun c:bomlengths () (initget "Lines Arcs Polylines Splines ALL") (setq ans (getkword "Enter an option [Lines/Arcs/Polylines/Splines] : " ) ) (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 . "") ) ) ) ) (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 . " ") ) ) (princ) ) (defun c:bom_splines () (bom-code '((0 . "SPLINE"))) (princ) )
Copyright © Сайт поддержки пользователей САПР