求个位大神写一个，批量选取矩形，标注矩形旋转角度的程序

664571221

求个位大神写一个，批量选取矩形，标注矩形旋转角度的程序

tigcat

1. ;获得多段线顶点
   
2. (setq
   
3.       ptn (mapcar
   
4.       'cdr
   
5.       (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget s1))
   
6.     )
   
7.     )
   
8. 
   
9. ;从ptn中选取邻近顶点,用angle算出角度
   
10. ;选位置写文字,用command或entmake都可以

;获得多段线顶点<br /> (setq<br />       ptn (mapcar<br />       'cdr<br />       (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget s1))<br />     )<br />     )<br /> <br /> ;从ptn中选取邻近顶点,用angle算出角度<br /> ;选位置写文字,用command或entmake都可以

664571221

tigcat 发表于 2022-1-4 14:00

你好大神，可以来一个可以运行的程序不

tigcat

664571221 发表于 2022-1-4 20:45
你好大神，可以来一个可以运行的程序不

我不是大神,菜鸟,我试试编一个.

664571221

tigcat 发表于 2022-1-4 21:04
我不是大神,菜鸟,我试试编一个.

好的 我看了你的帖子都是好东西，加下我qq3298554767

tigcat

664571221 发表于 2022-1-4 21:32
好的 我看了你的帖子都是好东西，加下我qq3298554767

1. ;函数是东抄西抄的
   
2. ;当天写好结果发现论坛崩溃了,一直到现在才能贴
   
3. (defun c:tt4 (/ en i ptn ptn_xmax ptn_ymin ss)
   
4.   (vl-load-com)
   
5.   (setq  ss (ssget '((0 . "lw*") (70 . 1)))
   
6.     i  0
   
7.   )
   
8.   (repeat (sslength ss)
   
9.     (setq en (ssname ss i))
   
10.     (setq
    
11.       ptn (mapcar
    
12.             'cdr
    
13.             (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget en))
    
14.           )
    
15.     )
    
16.     (setq ptn_ymin (vl-sort ptn (function (lambda (e1 e2)  (< (cadr e1) (cadr e2)) ) ) ))
    
17.     (setq ptn_xmax (vl-sort ptn (function (lambda (e1 e2)  (> (car e1) (car e2)) ) ) ))
    
18.     (if  (or (equal (angle (car ptn_ymin) (car ptn_xmax)) 0 1e-3)
    
19.           (equal (angle (car ptn_ymin) (car ptn_xmax)) (* 0.5 pi) 1e-3)
    
20.         )
    
21.       
    
22.       (entmake
    
23.         (list
    
24.           '(0 . "TEXT")
    
25.           (cons
    
26.             1
    
27.             "旋转角度0"
    
28.             
    
29.             
    
30.           )
    
31.           (cons 10 (append (car ptn_xmax) '(0)))
    
32.           (cons  40
    
33.             (* 0.4
    
34.               (min  (distance (car ptn) (cadr ptn))
    
35.                 (distance (cadr ptn) (caddr ptn))
    
36.               )
    
37.             )
    
38.           )
    
39.         )
    
40.       )
    
41.       (entmake
    
42.         (list
    
43.           '(0 . "TEXT")
    
44.           (cons
    
45.             1
    
46.             (strcat "旋转角度"
    
47.               (rtos (/ (* 180 (angle (car ptn_ymin) (car ptn_xmax)))pi) 2 2)
    
48.               "°"
    
49.             )
    
50.           )
    
51.           (cons 10 (append (car ptn_xmax) '(0)))
    
52.           (cons  40
    
53.             (* 0.4
    
54.               (min  (distance (car ptn) (cadr ptn))
    
55.                 (distance (cadr ptn) (caddr ptn))
    
56.               )
    
57.             )
    
58.           )
    
59.         )
    
60.       )
    
61.       
    
62.       
    
63.       
    
64.     )
    
65.     (setq i (1+ i))
    
66.   )
    
67.   (prin1)
    
68. )

;函数是东抄西抄的<br /> ;当天写好结果发现论坛崩溃了,一直到现在才能贴<br /> (defun c:tt4 (/ en i ptn ptn_xmax ptn_ymin ss)<br />   (vl-load-com)<br />   (setq  ss (ssget '((0 . "lw*") (70 . 1)))<br />     i  0<br />   )<br />   (repeat (sslength ss)<br />     (setq en (ssname ss i))<br />     (setq<br />       ptn (mapcar<br />             'cdr<br />             (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget en))<br />           )<br />     )<br />     (setq ptn_ymin (vl-sort ptn (function (lambda (e1 e2)  (< (cadr e1) (cadr e2)) ) ) ))<br />     (setq ptn_xmax (vl-sort ptn (function (lambda (e1 e2)  (> (car e1) (car e2)) ) ) ))<br />     (if  (or (equal (angle (car ptn_ymin) (car ptn_xmax)) 0 1e-3)<br />           (equal (angle (car ptn_ymin) (car ptn_xmax)) (* 0.5 pi) 1e-3)<br />         )<br />       <br />       (entmake<br />         (list<br />           '(0 . "TEXT")<br />           (cons<br />             1<br />             "旋转角度0"<br />             <br />             <br />           )<br />           (cons 10 (append (car ptn_xmax) '(0)))<br />           (cons  40<br />             (* 0.4<br />               (min  (distance (car ptn) (cadr ptn))<br />                 (distance (cadr ptn) (caddr ptn))<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (entmake<br />         (list<br />           '(0 . "TEXT")<br />           (cons<br />             1<br />             (strcat "旋转角度"<br />               (rtos (/ (* 180 (angle (car ptn_ymin) (car ptn_xmax)))pi) 2 2)<br />               "°"<br />             )<br />           )<br />           (cons 10 (append (car ptn_xmax) '(0)))<br />           (cons  40<br />             (* 0.4<br />               (min  (distance (car ptn) (cadr ptn))<br />                 (distance (cadr ptn) (caddr ptn))<br />               )<br />             )<br />           )<br />         )<br />       )<br />       <br />       <br />       <br />     )<br />     (setq i (1+ i))<br />   )<br />   (prin1)<br /> )

NewBug

没有测试图，只能动手画几个框了