【已解决】求一个框选数字批量新建对应数字图层并把数字下相应影像归入对应数字图...

3114637

一起框选中数字1和2，就新建一个图层名为1和2的图层，并把数字下对应的影像图归到图层1与图层2，数字1与2不用归到图层。如果有多个数字3，4，5，6，7，8也可以一并框选与上面一样。

marting

1. (defun c:tt (/)
   
2.   (if (and (xdrx-initssget "\n选择文字<退出>:")
   
3.            (setq ss (xdrx-ssget '((0 . "text"))))
   
4.            (setq imgss (ssget "x" '((0 . "IMAGE"))))
   
5.            (setq imgbox (xd::pnts:close (xdrx-entity-box imgss)))
   
6.       )
   
7.     (progn
   
8.       (xdrx-begin)
   
9.       (xd::doc:safezoom imgss)
   
10.       (mapcar '(lambda (x)
    
11.                  (setq box  (xdrx-text-box x)
    
12.                        box  (xdrx-points-wcs2ucs box)
    
13.                        p4   (xd::geom:get9pt box 4)
    
14.                        p6   (xd::geom:get9pt box 6)
    
15.                        ints (xdrx-get-inters (list p4 p6) imgbox 1)
    
16.                        ss1  (ssget "f" ints '((0 . "image")))
    
17.                  )
    
18.                  (setq
    
19.                    lst (mapcar '(lambda        (x)
    
20.                                   (list        (distance (xd::geom:get9pt x 5)
    
21.                                                   (xd::geom:get9pt box 5)
    
22.                                         )
    
23.                                         x
    
24.                                   )
    
25.                                 )
    
26.                                (xdrx-pickset->ents ss1)
    
27.                        )
    
28.                  )
    
29.                  (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
    
30.                        ent (cadr (car lst))
    
31.                  )
    
32.                  (xdrx-setpropertyvalue
    
33.                    ent
    
34.                    "layer"
    
35.                    (xdrx-getpropertyvalue x "textstring")
    
36.                  )
    
37.                )
    
38.               (xdrx-pickset->ents ss)
    
39.       )
    
40.       (xdrx-end)
    
41.     )
    
42.   )
    
43.   (princ)
    
44. )
    
45. 
    

(defun c:tt (/)<br />   (if (and (xdrx-initssget "\n选择文字<退出>:")<br />            (setq ss (xdrx-ssget '((0 . "text"))))<br />            (setq imgss (ssget "x" '((0 . "IMAGE"))))<br />            (setq imgbox (xd::pnts:close (xdrx-entity-box imgss)))<br />       )<br />     (progn<br />       (xdrx-begin)<br />       (xd::doc:safezoom imgss)<br />       (mapcar '(lambda (x)<br />                  (setq box  (xdrx-text-box x)<br />                        box  (xdrx-points-wcs2ucs box)<br />                        p4   (xd::geom:get9pt box 4)<br />                        p6   (xd::geom:get9pt box 6)<br />                        ints (xdrx-get-inters (list p4 p6) imgbox 1)<br />                        ss1  (ssget "f" ints '((0 . "image")))<br />                  )<br />                  (setq<br />                    lst (mapcar '(lambda        (x)<br />                                   (list        (distance (xd::geom:get9pt x 5)<br />                                                   (xd::geom:get9pt box 5)<br />                                         )<br />                                         x<br />                                   )<br />                                 )<br />                                (xdrx-pickset->ents ss1)<br />                        )<br />                  )<br />                  (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))<br />                        ent (cadr (car lst))<br />                  )<br />                  (xdrx-setpropertyvalue<br />                    ent<br />                    "layer"<br />                    (xdrx-getpropertyvalue x "textstring")<br />                  )<br />                )<br />               (xdrx-pickset->ents ss)<br />       )<br />       (xdrx-end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

3114637

marting 发表于 2020-6-6 04:57

谢谢 已解决

kyky1002

非常感谢二楼的分享

yuebirds

咱论坛，真是好多高手和热心人

QRWY

非常感谢分享