(用户选择的)折线的总长度
嘿，大家好！我已经处理这个问题很长一段时间了，似乎无法解决它。我想过也许让Lisp接收用户选择的折线，然后转储它们的信息并将其发送到DIESEL并从DIESEL中检索计算出的数字并在警报中吐出给用户，但我似乎无法让它工作，因为我无法运行任何VLAX代码。
那么，有没有什么方法可以代替下面代码中的VLAX...（从旧帖子复制并粘贴）
**** Hidden Message ***** 也许是这个？顺便说一句...欢迎来到TheSwamp
; Length/Area of Polyline by Layer
; David Bethel May 2004 from an original idea by David Watson
; This command will give a total area or length for all polylines on a specified layer.
;
(defun c:zone ( / ss la rv i tv op en)
(while (not ss)
(princ "\nPick any object on the required layer")
(setq ss (ssget)))
(initget "Length Area")
(setq rv (getkword "\nWould you like to measure Length/ : "))
(and (not rv)
(setq rv "Area"))
(setq la (cdr (assoc 8 (entget (ssname ss 0))))
ss (ssget "X" (list (cons 0 "*POLYLINE")
(cons 8 la)))
i (sslength ss)
tv 0
op 0)
(while (not (minusp (setq i (1- i))))
(setq en (ssname ss i))
(command "_.AREA" "_E" en)
(cond ((= rv "Length")
(setq tv (+ tv (getvar "PERIMETER"))))
(T
(setq tv (+ tv (getvar "AREA")))
(if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
(setq op (1+ op))))))
(princ (strcat "\nTotal " rv
" for layer " la
" = " (rtos tv 2 2)
" in " (itoa (sslength ss)) " polylines\n"
(if (/= rv "Length")
(strcat (itoa op) " with open polylines") "")))
(prin1)) 确定是因为没有用(vl-load-com)初始化VLAX吗？
尝试此例程
http://www . lee-MAC . com/totallengthndarea . html
;;--------------------=={ Total Length }==--------------------;;
;; ;;
;;Displays the total length of selected objects at the ;;
;;command line. The units and precision format of the ;;
;;printed result is dependent upon the settings of the ;;
;;LUNITS & LUPREC system variables respectively. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(defun c:tlen ( / e i l s )
(if (setq s
(ssget
'( (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
(-4 . "
(-4 . "
(0 . "POLYLINE") (-4 . "&") (70 . 80)
(-4 . "AND>")
(-4 . "NOT>")
)
)
)
(progn
(setq l 0.0)
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
)
)
(princ "\nTotal Length: ")
(princ (rtos l))
)
)
(princ)
)
(vl-load-com) (princ) 我在土木设计工作，所以我最终需要更详细级别。
Cheers
AddLlong-支持圆弧、线条、折线和土木3D管道：
(defun c:AddLength (/ *error* ss l p)
(defun *error* (msg)
(if ss (vla-delete ss))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ;or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if (ssget "_:L" '((0 . "AECC_PIPE,ARC,LINE,*POLYLINE")))
(progn
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(cond
((= "AeccDbPipe" (vla-get-objectname x))
;;
(setq p (cons (vlax-get x 'length2d) p))
)
((setq l
(cons
(vlax-get x
(if (= "AcDbArc" (vla-get-objectname x))
'arclength
'length
)
)
l
)
)
)
)
)
(if p
(prompt (strcat "\nTotal pipe length: "
(rtos (setq p (apply '+ p)) 2 2)
" LF | "
(rtos (/ p 3.0) 2 2)
" LY | "
(rtos (/ p 5280.0) 2 2)
" MI "
)
)
)
(if l
(prompt (strcat "\nTotal length: "
(rtos (setq l (apply '+ l)) 2 2)
" LF | "
(rtos (/ l 3.0) 2 2)
" LY | "
(rtos (/ l 5280.0) 2 2)
" MI "
)
)
)
)
)
(*error* nil)
)
AddArea-支持圆圈、阴影和折线：
(defun c:AddArea (/ *error* ss area)
(defun *error* (msg)
(if ss (vla-delete ss))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ;or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if (ssget '((0 . "CIRCLE,HATCH,*POLYLINE")))
(progn
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(setq area (cons (vla-get-area x) area))
)
(prompt (strcat "\nTotal area: "
(rtos (setq area (apply '+ area)) 2 2)
" SF | "
(rtos (/ area 9.0) 2 2)
" SY | "
(rtos (/ area 43560.0) 2 2)
" AC "
)
)
)
)
(*error* nil)
)
页:
[1]