周长统计

树櫴希德

2. (defun vxs (e / i v lst)
   
3.   (setq i 0)
   
4.   (while
   
5.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   
6.      (setq lst (cons v lst))
   
7.   )
   
8.   (reverse lst))
   
9. ;;;;;;;;;;;;;;;
   
10. (defun zhouchang ( en / dd )
    
11. (setvar "cmdecho" 0)
    
12.   ;(setq en (car (entsel "\n选取计算长度的曲线...")))
    
13.   (command "lengthen" en "")
    
14.   (setq dd (getvar "perimeter"))
    
15.   dd
    
16.   )
    
17. 
    
18. 
    
19. (defun c:tt11 ( / lst ent pts pt demj zmj ) ;标记三角网表面积
    
20. 
    
21.   (setq lst (ssget '( (0 . "lwpolyline") (8 . "0")) ) )
    
22. (setq i 0)
    
23. (setq zmj 0.000)
    
24.   
    
25. (while  (< i (sslength lst))
    
26. 
    
27. (setq ent (ssname lst i))
    
28. 
    
29. (setq pts (vxs ent))
    
30.   (setq len (length pts))
    
31. (setq pt (mapcar
    
32.   '(lambda(x)
    
33.     (/ x len)
    
34.   )
    
35.   (apply
    
36.     'mapcar
    
37.     (cons '+ pts)
    
38.   )
    
39. )
    
40. )
    
41. 
    
42. (setq    AcadObject   (vlax-get-acad-object)
    
43. 
    
44.           AcadDocument (vla-get-ActiveDocument Acadobject)
    
45. 
    
46.           mSpace    (vla-get-ModelSpace Acaddocument)) ;初始化系统
    
47. 
    
48. 
    
49.   
    
50. 
    
51.   (setq demj (zhouchang ent))
    
52.   
    
53.   (entmake (list (cons 0  "TEXT") (cons 1 (rtos demj 2 3)) (cons 10 pt)
    
54.                (cons 40 0.5)
    
55.                (cons 8 "周长")
    
56.                ))
    
57. 
    
58. 
    
59.   
    
60.   
    
61.   
    
62. (setq zmj(+ zmj demj))
    
63. 
    
64. (setq i (+ i 1))
    
65.   
    
66.   
    
67.   )
    
68. (entmake (list (cons 0  "TEXT") (cons 1 (rtos zmj 2 3)) (cons 10 (getpoint "\请输入总周长插入点"))
    
69.                (cons 40 3)
    
70.                (cons 8 "周长")
    
71.                ))
    
72. (print zmj)
    
73.   (princ)
    
74. 
    
75. )

(defun vxs (e / i v lst)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst))<br /> ;;;;;;;;;;;;;;;<br /> (defun zhouchang ( en / dd )<br /> (setvar "cmdecho" 0)<br />   ;(setq en (car (entsel "\n选取计算长度的曲线...")))<br />   (command "lengthen" en "")<br />   (setq dd (getvar "perimeter"))<br />   dd<br />   )<br /> <br /> <br /> (defun c:tt11 ( / lst ent pts pt demj zmj ) ;标记三角网表面积<br /> <br />   (setq lst (ssget '( (0 . "lwpolyline") (8 . "0")) ) )<br /> (setq i 0)<br /> (setq zmj 0.000)<br />   <br /> (while  (< i (sslength lst))<br /> <br /> (setq ent (ssname lst i))<br /> <br /> (setq pts (vxs ent))<br />   (setq len (length pts))<br /> (setq pt (mapcar<br />   '(lambda(x)<br />     (/ x len)<br />   )<br />   (apply<br />     'mapcar<br />     (cons '+ pts)<br />   )<br /> )<br /> )<br /> <br /> (setq    AcadObject   (vlax-get-acad-object)<br /> <br />           AcadDocument (vla-get-ActiveDocument Acadobject)<br /> <br />           mSpace    (vla-get-ModelSpace Acaddocument)) ;初始化系统<br /> <br /> <br />   <br /> <br />   (setq demj (zhouchang ent))<br />   <br />   (entmake (list (cons 0  "TEXT") (cons 1 (rtos demj 2 3)) (cons 10 pt)<br />                (cons 40 0.5)<br />                (cons 8 "周长")<br />                ))<br /> <br /> <br />   <br />   <br />   <br /> (setq zmj(+ zmj demj))<br /> <br /> (setq i (+ i 1))<br />   <br />   <br />   )<br /> (entmake (list (cons 0  "TEXT") (cons 1 (rtos zmj 2 3)) (cons 10 (getpoint "\请输入总周长插入点"))<br />                (cons 40 3)<br />                (cons 8 "周长")<br />                ))<br /> (print zmj)<br />   (princ)<br /> <br /> )

434939575

支持源码！

tang87

支持源码      ，但这个只对rec有用，对别的就没用了。      

happy336

谢谢分享，支持