选择圆，改成闭合多段线

tangweinbs

;选择圆，从左到右从上到下排序编号
(defun c:tt (/ FN FFILE SS I ENTS EN PT EN1 PTS PTLST STRLST)
        (initget 1 "Y N")
        (setq write (getkword "\n 是否加入前缀 (Y)是 (N)否："))
        (if (wcmatch write "Y")
                (setq str (getstring "\n 请输入前缀"))
        )
        (if (setq ss (ssget (list (cons 0 "CIRCLE"))))
                (progn
                        (setq i -1 ents nil)
                        (while (setq en (ssname ss (setq i (1+ i))))
                                (setq pt (cdr (assoc 10 (entget en))))                               
                                (setq en1(list (car pt) (cadr pt) (cadr pt) en))
                                (setq ents (cons en1 ents))                               
                        )                       
                        (setq ents (mapcar '(lambda (x) (nth 3 x)) (vl-sort (vl-sort ents '(lambda (a b) (< (car a) (car b)))) '(lambda (c d) (> (cadr c) (cadr d))))))
                        (setq i 0)                       
                        (mapcar '(lambda (x)
                                                                 (setq pt (cdr (assoc 10 (entget x))))
                                                                 (entmakex
                                                                         (list '(0 . "text")
                                                                                 (cons 1 (if (wcmatch write "Y") (strcat str (itoa (setq i (1+ i))))(itoa (setq i (1+ i)))))
                                                                                 (cons 10 pt)
                                                                                 (cons 62 3)
                                                                                 (cons 40 2.5)
                                                                                 (cons 11 pt)
                                                                                 (cons 72 1)
                                                                                 (cons 73 2)                                                                                 
                                                                         )                                                                         
                                                                 )
                                                                 (setq pts (cons pt pts))
                                                         )
                                ents                               
                        )


这个功能是实现选择圆，从左到右从上到下排序编号，求助帮忙改成选成闭合多段线，从左到右从上到下排序编号。

煮茗

llsheng_73 发表于 2024-12-15 13:00
(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . ">") (90 . 2)  (70 . 1))))
这样过滤是有问题的：因为2 ...

感谢大佬指导~

煮茗

2. ;选择闭合多段线，从左到右从上到下排序编号
   
3. (defun c:tt (/ FN FFILE SS I ENTS EN PT EN1 PTS PTLST STRLST)
   
4. (VL-LOAD-COM )
   
5.         (initget 1 "Y N")
   
6.         (setq write (getkword "\n 是否加入前缀 (Y)是 (N)否："))
   
7.         (if (wcmatch write "Y")
   
8.                 (setq str (getstring "\n 请输入前缀"))
   
9.         )
   
10.         (if <span style="background-color: rgb(255, 255, 255);">(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))</span>
    
11.                 (progn
    
12.                         (setq i -1 ents nil)
    
13.                         (while (setq en (ssname ss (setq i (1+ i))))
    
14.                                 (setq pt (find-centerpoint en))         
    
15.                                 (setq en1(list (car pt) (cadr pt) (cadr pt) en))
    
16.                                 (setq ents (cons en1 ents))                              
    
17.                         )                       
    
18.                         (setq ents (mapcar '(lambda (x) (nth 3 x)) (vl-sort (vl-sort ents '(lambda (a b) (< (car a) (car b)))) '(lambda (c d) (> (cadr c) (cadr d))))))
    
19.                         (setq i 0)                       
    
20.                         (mapcar '(lambda (x)
    
21.                         (setq pt (find-centerpoint x))
    
22.                         (entmakex
    
23.                                 (list '(0 . "text")
    
24.                                         (cons 1 (if (wcmatch write "Y") (strcat str (itoa (setq i (1+ i))))(itoa (setq i (1+ i)))))
    
25.                                         (cons 10 pt)
    
26.                                         (cons 62 3)
    
27.                                         (cons 40 200)
    
28.                                         (cons 11 pt)
    
29.                                         (cons 72 1)
    
30.                                         (cons 73 2)                                       
    
31.                                 )                                
    
32.                         )
    
33.                         (setq pts (cons pt pts))
    
34.                                  )
    
35.                                 ents                              
    
36.                         )
    
37.                                 )
    
38.                 )
    
39. )
    
40. 
    
41. (defun find-centerpoint(en / po-li n y pc)
    
42.   (setq entda(entget en)
    
43.         ename(cdr(assoc 0 entda)))
    
44.   (if(= ename "CIRCLE")
    
45.     (setq pc(cdr(assoc 10 entda)))
    
46.     (progn
    
47.       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))
    
48.       (setq n(length po-li))  
    
49.       (setq y(apply 'mapcar (cons '+ po-li)))
    
50.       (setq pc(mapcar '/ y (list n n n)))
    
51.       );progn
    
52.     );end if
    
53.   );end defun

;选择闭合多段线，从左到右从上到下排序编号<br /> (defun c:tt (/ FN FFILE SS I ENTS EN PT EN1 PTS PTLST STRLST)<br /> (VL-LOAD-COM )<br />         (initget 1 "Y N")<br />         (setq write (getkword "\n 是否加入前缀 (Y)是 (N)否："))<br />         (if (wcmatch write "Y")<br />                 (setq str (getstring "\n 请输入前缀"))<br />         )<br />         (if <span style="background-color: rgb(255, 255, 255);">(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))</span><br />                 (progn<br />                         (setq i -1 ents nil)<br />                         (while (setq en (ssname ss (setq i (1+ i))))<br />                                 (setq pt (find-centerpoint en))         <br />                                 (setq en1(list (car pt) (cadr pt) (cadr pt) en))<br />                                 (setq ents (cons en1 ents))                               <br />                         )                       <br />                         (setq ents (mapcar '(lambda (x) (nth 3 x)) (vl-sort (vl-sort ents '(lambda (a b) (< (car a) (car b)))) '(lambda (c d) (> (cadr c) (cadr d))))))<br />                         (setq i 0)                       <br />                         (mapcar '(lambda (x)<br />                         (setq pt (find-centerpoint x))<br />                         (entmakex<br />                                 (list '(0 . "text")<br />                                         (cons 1 (if (wcmatch write "Y") (strcat str (itoa (setq i (1+ i))))(itoa (setq i (1+ i)))))<br />                                         (cons 10 pt)<br />                                         (cons 62 3)<br />                                         (cons 40 200)<br />                                         (cons 11 pt)<br />                                         (cons 72 1)<br />                                         (cons 73 2)                                        <br />                                 )                                <br />                         )<br />                         (setq pts (cons pt pts))<br />                                  )<br />                                 ents                               <br />                         )<br />                                 )<br />                 )<br /> )<br /> <br /> (defun find-centerpoint(en / po-li n y pc)<br />   (setq entda(entget en)<br />         ename(cdr(assoc 0 entda)))<br />   (if(= ename "CIRCLE")<br />     (setq pc(cdr(assoc 10 entda)))<br />     (progn<br />       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))<br />       (setq n(length po-li))  <br />       (setq y(apply 'mapcar (cons '+ po-li)))<br />       (setq pc(mapcar '/ y (list n n n)))<br />       );progn<br />     );end if<br />   );end defun

tangweinbs

测试了一下，编号加不上去啊？


我用的是CAD2008  

煮茗

tangweinbs 发表于 2024-12-15 09:14
测试了一下，编号加不上去啊？

方便图纸文件上传看看不？
你这图片看不到。

tangweinbs

煮茗 发表于 2024-12-15 01:46

测试了一下，编号加不上去啊？


我用的是CAD2008  

煮茗

tangweinbs 发表于 2024-12-15 09:23
测试了一下，编号加不上去啊？

CAD2008可能版本太老了？
我在2014以上测试成功的。

tangweinbs

煮茗 发表于 2024-12-15 10:09
CAD2008可能版本太老了？
我在2014以上测试成功的。

我主要是用2004-2008的CAD，功能就是你测试的这个，我装了一个2010 也没成功

llsheng_73

煮茗 发表于 2024-12-15 01:46

(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . ">") (90 . 2)  (70 . 1))))
这样过滤是有问题的：因为2个点也可以闭合，不过有凸度，闭合也不一定70组等于1，70组是按位编码的，只要含有1就是闭合，具体的数值可能有多种,比如1，129(+ 128 1)都是很常见的，也可能有其它数值
(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))

tangweinbs

llsheng_73 发表于 2024-12-15 13:00
(setq ss (ssget  '((0 . "LWPOLYLINE") (-4 . ">") (90 . 2)  (70 . 1))))
这样过滤是有问题的：因为2 ...

感谢大佬指导