如何提取任意四边形的长度和角度,并将参数写到多边形里

slzlfs

如何提取任意四边形的长度和角度,并将参数写到多边形里，并且每个顶点给标记号是那个点，效果看附件

slzlfs

高手 大侠们 快来啊

slzlfs

自己顶一下

zhynt

2. 
   
3. (defun c:test ()
   
4.   (setq sen (car (entsel "\n选择四边形:")))
   
5.   (setq        pt_lst (mapcar 'cdr
   
6.                        (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget sen))
   
7.                )
   
8.   )
   
9.   (setq        pta (nth 0 pt_lst)
   
10.         ptb (nth 1 pt_lst)
    
11.         ptc (nth 2 pt_lst)
    
12.         ptd (nth 3 pt_lst)
    
13.   )
    
14.   (setq        l1 (distance pta ptb)
    
15.         l2 (distance ptb ptc)
    
16.         l3 (distance ptc ptd)
    
17.         l4 (distance pta ptd)
    
18.   )
    
19.   (setq        ang1 (angle pta ptd)
    
20.         ang2 (angle pta ptb)
    
21.   )
    
22.   (setq        ang3 (angle ptb ptc)
    
23.         ang4 (angle ptb pta)
    
24.   )
    
25.   (setq        ang5 (angle ptc ptd)
    
26.         ang6 (angle ptc ptb)
    
27.   )
    
28.   (setq        ang7 (angle ptd pta)
    
29.         ang8 (angle ptd ptc)
    
30.   )
    
31.   (setq        anga (abs (* (- ang1 ang2) (/ 180.0 pi)))
    
32.         angb (abs (* (- ang3 ang4) (/ 180.0 pi)))
    
33.         angc (abs (* (- ang5 ang6) (/ 180.0 pi)))
    
34.         angd (abs (* (- ang7 ang8) (/ 180.0 pi)))
    
35.   )
    
36.   (if (> anga 180)
    
37.     (setq anga (- 360 anga))
    
38.   )
    
39.   (if (> angb 180)
    
40.     (setq angb (- 360 angb))
    
41.   )
    
42.   (if (> angc 180)
    
43.     (setq angc (- 360 angc))
    
44.   )
    
45.   (if (> angd 180)
    
46.     (setq angd (- 360 angd))
    
47.   )
    
48.   (setq        txt (strcat (rtos l1)
    
49.                     ","
    
50.                     (rtos l2)
    
51.                     ","
    
52.                     (rtos l3)
    
53.                     ","
    
54.                     (rtos l4)
    
55.                     ",,,,"
    
56.                     (rtos anga)
    
57.                     ","
    
58.                     (rtos angb)
    
59.                     ","
    
60.                     (rtos angc)
    
61.                     ","
    
62.                     (rtos angd)
    
63.             )
    
64.   )
    
65.   (command "TEXT" "J" "MC" pta "30" "0" "p0" "")
    
66.   (command "TEXT" "J" "MC" ptb "30" "0" "p1" "")
    
67.   (command "TEXT" "J" "MC" ptc "30" "0" "p2" "")
    
68.   (command "TEXT" "J" "MC" ptd "30" "0" "p3" "")
    
69.   (setq pt (getpoint "\n标注位置:"))
    
70.   (command "TEXT" pt "30" "0" txt "")
    
71. )
    

<br /> (defun c:test ()<br />   (setq sen (car (entsel "\n选择四边形:")))<br />   (setq        pt_lst (mapcar 'cdr<br />                        (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget sen))<br />                )<br />   )<br />   (setq        pta (nth 0 pt_lst)<br />         ptb (nth 1 pt_lst)<br />         ptc (nth 2 pt_lst)<br />         ptd (nth 3 pt_lst)<br />   )<br />   (setq        l1 (distance pta ptb)<br />         l2 (distance ptb ptc)<br />         l3 (distance ptc ptd)<br />         l4 (distance pta ptd)<br />   )<br />   (setq        ang1 (angle pta ptd)<br />         ang2 (angle pta ptb)<br />   )<br />   (setq        ang3 (angle ptb ptc)<br />         ang4 (angle ptb pta)<br />   )<br />   (setq        ang5 (angle ptc ptd)<br />         ang6 (angle ptc ptb)<br />   )<br />   (setq        ang7 (angle ptd pta)<br />         ang8 (angle ptd ptc)<br />   )<br />   (setq        anga (abs (* (- ang1 ang2) (/ 180.0 pi)))<br />         angb (abs (* (- ang3 ang4) (/ 180.0 pi)))<br />         angc (abs (* (- ang5 ang6) (/ 180.0 pi)))<br />         angd (abs (* (- ang7 ang8) (/ 180.0 pi)))<br />   )<br />   (if (> anga 180)<br />     (setq anga (- 360 anga))<br />   )<br />   (if (> angb 180)<br />     (setq angb (- 360 angb))<br />   )<br />   (if (> angc 180)<br />     (setq angc (- 360 angc))<br />   )<br />   (if (> angd 180)<br />     (setq angd (- 360 angd))<br />   )<br />   (setq        txt (strcat (rtos l1)<br />                     ","<br />                     (rtos l2)<br />                     ","<br />                     (rtos l3)<br />                     ","<br />                     (rtos l4)<br />                     ",,,,"<br />                     (rtos anga)<br />                     ","<br />                     (rtos angb)<br />                     ","<br />                     (rtos angc)<br />                     ","<br />                     (rtos angd)<br />             )<br />   )<br />   (command "TEXT" "J" "MC" pta "30" "0" "p0" "")<br />   (command "TEXT" "J" "MC" ptb "30" "0" "p1" "")<br />   (command "TEXT" "J" "MC" ptc "30" "0" "p2" "")<br />   (command "TEXT" "J" "MC" ptd "30" "0" "p3" "")<br />   (setq pt (getpoint "\n标注位置:"))<br />   (command "TEXT" pt "30" "0" txt "")<br /> )<br />

ljpnb

zhynt 发表于 2011-7-28 10:18

每句TEXT后面都多了一对""

zhynt

回复 ljpnb 的帖子

难道又是版本的问题，我这里没问题，又或许是字体设置的问题？

ljpnb

2010上也试过了，也是出现：
命令:
标注位置:TEXT
当前文字样式:  “STANDARD”  文字高度:  30.0000  注释性:  否
指定文字的起点或 [对正(J)/样式(S)]:
指定高度 <30.0000>: 30
指定文字的旋转角度 <0>: 0
输入文字: 119.6114,80.6407,119.1888,80.8056,,,,66.903,112.8208,67.1792,113.097
命令: TEST 未知命令“TEST”。按 F1 查看帮助。

zhynt

嗯确实多了