je to pomocou lispu a tu je script

 

je to z ineho fora, takze vdaka povodnemu autorovi.

 

;;;=======================[ Length.lsp ]=========================
;;; Author: Copyright© 2005 Charles Alan Butler
;;; Version: 1.0 July 12, 2005
;;; Purpose: display the length of a selected objects
;;; and a running total
;;; Sub_Routines: -None
;;; Returns: -NA
;;;=============================================== ===============
;|
I know there are many fine "Length" routines around.
This is my version and it allows the user to pick each object & displays
the length & a running total on the command line.
An option at start up lets the user optionally put the result in the drawing.
The text is placed at the user pick point and the current text style & layer are used.
The options for text insert are:
None - No text is inserted, this is the default
Each - Text is inserted after each object is selected
Total - Text is inserted only at the end of all selections & only the total is inserted.

Exit the routine by pressing Enter or picking nothing
Pressing C enter will clear the total
Pressing Enter while placing the text will skip the insert for that object.
|;
(defun c:length (/ en len pt txt ent_allowed total_len typ)
(vl-load-com)
(defun put_txt (txt / pt)
;; Check if the drawing height is set to 0:
(if (setq pt (getpoint "\nPick Text Location..."))
(if (= 0 (cdr (assoc 40
(tblsearch "style"
(getvar "textstyle")))))
(command "text" "non" pt "" "0" txt)
(command "text" "non" pt "0" txt)
) ; endif
(prompt "\n*** Text Insert skipped ***")
)
)

(initget "Each Total None" )
(setq txt_opt (getkword "\nPut text in drawing for [Each/Total/None]. <None>"))
(or txt_opt (setq txt_opt "None"))


(setq ent_allowed '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "ARC" "CIRCLE")
total_len 0
)
(while (or (initget "C")
(setq en (entsel "\nPick object for length, C to clear total."))
)
(if (= "C" en)
(progn
(if (member txt_opt '("Each" "Total"))
(put_txt (strcat "Total "(rtos total_len)))
)
(setq total_len 0) ; clear length total
)
(progn
(setq en (car en))
(if (member (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
(progn
(setq
len (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
)
(setq total_len (+ len total_len))
(princ (strcat "\n"typ " length = " (rtos len)
" Running total is " (rtos total_len))
)
(if (= txt_opt "Each") (put_txt (rtos len)))
) ; progn
(alert "Not a valid object for length")
)
)
)

)
(and (not (zerop total_len))
(princ (strcat "\nTotal length is " (rtos total_len)))
(if (member txt_opt '("Each" "Total"))
(put_txt (strcat "Total "(rtos total_len)))
)
)
(princ)
)
(prompt "\nGet Length loaded, Enter length to run")
(princ)