【LISP程序】求曲线长度 －by eachy

XDSoft

2. ;|
   
3.   命令：plen
   
4.   功能：根据图层统计选择线长的长度
   
5.   
   
6.   要求全局变量bl存在，即出图比例。
   
7.   
   
8.   配合XDRX_API使用
   
9. |;
   
10. (defun redraw_le ()
    
11.   (foreach e le_drw (redraw e 4))
    
12.   (foreach e le_del (entdel e))
    
13.   (setq    le_drw nil
    
14.     le_del nil
    
15.   )
    
16. )
    
17. 
    
18. (defun c:plen (/ e ss ss1 leng pt ll)
    
19.   (xdrx_begin "tmp" "3" '("cmdecho" "0"))
    
20.   (xdrx_ucson)
    
21.   (setq e (car (entsel "\n请点取要统计多义线长度图层上的实体<退出>:")))
    
22.   (princ "\n再拾取选择范围<全选>: ")
    
23.   (setq    ed (entget e)
    
24.     ll (list '(0 . "Line,*polyline,arc,spline,Ellipse,circle")
    
25.          (assoc 8 ed)
    
26.       )
    
27.     ss (ssget "x" ll)
    
28.   )
    
29.   (xdrx_setsstodb ss 0)
    
30.   (while (setq e (xdrx_getentdata 0))
    
31.     (redraw e 3)
    
32.     (setq le_drw (cons e le_drw))
    
33. 
    
34.   )
    
35.   (setq    ss1 (ssget ll)
    
36.     ss  (if    ss1
    
37.           ss1
    
38.           ss
    
39.         )
    
40.   )
    
41.   (redraw_le)
    
42.   (setq    leng 0.0)
    
43.   (xdrx_setsstodb ss 0)
    
44.   (while (setq e (xdrx_getentdata 0))
    
45.     (setq leng (+ (cadr (xdrx_getarea e)) leng))
    
46.   )
    
47.   (initget 1)
    
48.   (setq pt (getpoint "\n请点取标注位置:"))
    
49.   (if (not
    
50.     (setq
    
51.       hi (getreal
    
52.           (strcat "\n请输入字高<" (rtos (* 3 bl) 2 0) ">:")
    
53.         )
    
54.     )
    
55.       )
    
56.     (setq hi (* 3 bl))
    
57.   )
    
58.   (setvar "osmode" 0)
    
59.   (command "text"
    
60.       pt
    
61.       hi
    
62.       ""
    
63.       (strcat (xdrx_getentdxf 8)
    
64.           "  线长: "
    
65.           (rtos (/ leng 1000.0) 2 2)
    
66.       )
    
67.   )
    
68.   (xdrx_ucsoff)
    
69.   (xdrx_end)
    
70.   (princ)
    
71. )

;| <br />   命令：plen <br />   功能：根据图层统计选择线长的长度 <br />   <br />   要求全局变量bl存在，即出图比例。 <br />   <br />   配合XDRX_API使用 <br /> |; <br /> (defun redraw_le () <br />   (foreach e le_drw (redraw e 4)) <br />   (foreach e le_del (entdel e)) <br />   (setq    le_drw nil <br />     le_del nil <br />   ) <br /> ) <br /> <br /> (defun c:plen (/ e ss ss1 leng pt ll) <br />   (xdrx_begin "tmp" "3" '("cmdecho" "0")) <br />   (xdrx_ucson) <br />   (setq e (car (entsel "\n请点取要统计多义线长度图层上的实体<退出>:"))) <br />   (princ "\n再拾取选择范围<全选>: ") <br />   (setq    ed (entget e) <br />     ll (list '(0 . "Line,*polyline,arc,spline,Ellipse,circle") <br />          (assoc 8 ed) <br />       ) <br />     ss (ssget "x" ll) <br />   ) <br />   (xdrx_setsstodb ss 0) <br />   (while (setq e (xdrx_getentdata 0)) <br />     (redraw e 3) <br />     (setq le_drw (cons e le_drw)) <br /> <br />   ) <br />   (setq    ss1 (ssget ll) <br />     ss  (if    ss1 <br />           ss1 <br />           ss <br />         ) <br />   ) <br />   (redraw_le) <br />   (setq    leng 0.0) <br />   (xdrx_setsstodb ss 0) <br />   (while (setq e (xdrx_getentdata 0)) <br />     (setq leng (+ (cadr (xdrx_getarea e)) leng)) <br />   ) <br />   (initget 1) <br />   (setq pt (getpoint "\n请点取标注位置:")) <br />   (if (not <br />     (setq <br />       hi (getreal <br />           (strcat "\n请输入字高<" (rtos (* 3 bl) 2 0) ">:") <br />         ) <br />     ) <br />       ) <br />     (setq hi (* 3 bl)) <br />   ) <br />   (setvar "osmode" 0) <br />   (command "text" <br />       pt <br />       hi <br />       "" <br />       (strcat (xdrx_getentdxf 8) <br />           "  线长: " <br />           (rtos (/ leng 1000.0) 2 2) <br />       ) <br />   ) <br />   (xdrx_ucsoff) <br />   (xdrx_end) <br />   (princ) <br /> )

walpax

好清楚
感谢

leaderist

经常做竖向，太谢谢了。

bridgewind

呵呵，不错！好好学习编写方法！
－－－－－－－－－－－－－－－－
推荐《Visual lisp 程序设计技巧与范例》
对我帮助真的很大！！！