如何计算所点选的所有线段长

lead009

大家好

我想问一下，如果在图面上有一个由很多线段组成的路径

我要如何透过lisp来计算它的总长度呢

 

传统的方式是点选每一段长度，然后用计算机慢慢加

Andyhon

先参考一下这之前的讨论

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=77256&replyID=18733&skin=0
http://bbs.mjtd.com/dispbbs.asp?boardid=16&replyID=100419&ID=5810&skin=0

461045462

lead009发表于2010-9-3 21:28:00大家好 我想问一下，如果在图面上有一个由很多线段组成的路径 我要如何透过lisp来计算它的总长度呢   传统的方式是点选每一段长度，然后用计算机慢慢加 下载 文件大小:3.7 KB，下载

站内搜索更多有关 [如何计算所点选的所有线段长] 的信息

 

 

网站上有框选然后标注总长度的程序，不必一个一个的加

wgq2808

编辑成多段线，然后用LIST命令直接查询

lead009

我用了list指令去查詢，但是視窗還是個別顯示出所選的線段長度

我要怎麼用，才能讓他們自動加起來呢??

dalin1985

(DEFUN C:zzz ()
  (setq tot_len 0) 
  (prompt "\nSelect all objects to count: ")
  (setq ss (ssget))
  (while (> (sslength ss) 0)
    (setq en (ssname ss 0))
    (setq ed (entget en))
    (setq e_type (cdr (assoc '0 ed)))
    (cond
      ((= e_type "LINE") (add_lines))
      ((= e_type "ARC") (add_arcs))
      ((= e_type "POLYLINE") (add_poly))
      ((or
  (/= e_type "LINE")
  (/= e_type "ARC")
  (/= e_type "POLYLINE")
       )
       (ssdel en ss)
      )
    )
  )
  (prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))(PRINC)
)

(defun add_lines ()
  (setq pt1 (cdr (assoc '10 ed)))
  (setq pt2 (cdr (assoc '11 ed)))
  (setq line_len (distance pt1 pt2))
  (setq tot_len (+ tot_len line_len))
  (ssdel en ss)
)

(defun add_arcs ()
  (SETQ CEN (CDR (ASSOC '10 Ed))
        RAD (CDR (ASSOC '40 Ed))
        DIA (* RAD 2.0)
        CIRCUM (* (* RAD PI) 2.0)
        S_ANG (CDR (ASSOC '50 Ed))
        E_ANG (CDR (ASSOC '51 Ed))
  )
  (IF (< E_ANG S_ANG)
    (SETQ E_ANG (+ E_ANG (* PI 2.0)))
  )
  (SETQ
        N_ANG (- E_ANG S_ANG)
        N_ANG_1 (* (/ N_ANG PI) 180.0)
        PART_CIRC (/ N_ANG_1 360.0) 
        A_LEN (* PART_CIRC CIRCUM)
  )
  (setq tot_len (+ tot_len a_len))
  (PRIN1)
  (SSDEL EN SS)
)

(defun add_poly ()
  (command "area" "e" en)
  (setq tot_len (+ tot_len (getvar "perimeter")))
  (ssdel en ss)
)

 

 

一个计算线段长度的lisp

lenlenq

 简单的来一个
(defun c:xl (/ en obj curve-length)
  (while (null (setq en (car (entsel)))))
  (command "pedit" en "j" (ssget "all") "" "")
  (setq en (entlast))
  (setq obj (vlax-ename->vla-object en))
  (setq curve-length (vla-get-length obj))
  (vl-cmdf "explode" en)
  curve-length
)

alin

2. ;; by ALin 2010
3. (defun C:ToLLen    (/ ss idx obj tol cnt)
4. (if (setq ss (ssget))
5. (progn
6. (setq idx    0
7.      tol    0
8.      cnt    0
9. )
10. (repeat (sslength ss)
11.     (setq obj (vlax-ename->vla-object (ssname ss idx)))
12.     (if (vlax-property-available-p obj 'length)
13.      (setq    tol (+ tol (vla-get-length obj))
14.         cnt (1+ cnt)
15.      )
16.      (progn
17.      (if    (CurveLength obj)
18.      (setq tol    (+ tol (CurveLength obj))
19.          cnt    (1+ cnt)
20.      )
21.      (alert (strcat "No length property available for "
22.              (vla-get-objectname obj)
23.              "."
24.          )
25.      )
26.      )
27.      )
28.     )
29.     (setq idx (1+ idx))
30. )
31. (alert (strcat (itoa cnt)
32.          " object(s) total length = "
33.          (rtos tol 2 4)
34.          " units."
35.      )
36. )
37. )
38. )
39. (princ)
40. )
42. (defun CurveLength (obj / rtn endparam)
43. (if (not (vl-catch-all-error-p
44.      (setq endparam
45.          (vl-catch-all-apply 'vlax-curve-getendparam (list obj))
46.      )
47.      )
48. )
49. (if    (setq rtn (vlax-curve-getdistatparam obj endparam))
50. rtn
51. nil
52. )
53. nil
54. )
55. )

;; by ALin 2010 (defun C:ToLLen    (/ ss idx obj tol cnt) (if (setq ss (ssget)) (progn (setq idx    0      tol    0      cnt    0 ) (repeat (sslength ss)     (setq obj (vlax-ename->vla-object (ssname ss idx)))     (if (vlax-property-available-p obj 'length)      (setq    tol (+ tol (vla-get-length obj))         cnt (1+ cnt)      )      (progn      (if    (CurveLength obj)      (setq tol    (+ tol (CurveLength obj))          cnt    (1+ cnt)      )      (alert (strcat "No length property available for "              (vla-get-objectname obj)              "."          )      )      )      )     )     (setq idx (1+ idx)) ) (alert (strcat (itoa cnt)          " object(s) total length = "          (rtos tol 2 4)          " units."      ) ) ) ) (princ) ) (defun CurveLength (obj / rtn endparam) (if (not (vl-catch-all-error-p      (setq endparam          (vl-catch-all-apply 'vlax-curve-getendparam (list obj))      )      ) ) (if    (setq rtn (vlax-curve-getdistatparam obj endparam)) rtn nil ) nil ) )

q530496591

留个记号!来了啊!