求高手帮忙实现如下小功能

包哥

先通过拾取两角点绘制一个矩形，然后移动光标（注意不是鼠标左键单击，只是移动鼠标改变光标位置），根据十字光标所在位置（pt1）计算离pt1最近的矩形角点（jd1），将pt1和jd1连线

ssyfeng

看看是不是这个效果：

liuhe

1. (DEFUN C:TT (/ P1 P2 P3 P4 LST LOOP GR CODE PT PX E1)
   
2.   (SETQ        P1   (GETPOINT "\n矩形第一点")
   
3.         P2   (GETCORNER P1 "\n 矩形第二点")
   
4.         P3   (LIST (CAR P1) (CADR P2))
   
5.         P4   (LIST (CAR P2) (CADR P1))
   
6.         LST(LIST P1 P3 P2 P4 P1)
   
7.         LOOP T
   
8.   )
   
9.   (ENTMAKEX
   
10.     (APPEND
    
11.       (list '(0 . "LWPOLYLINE")
    
12.      '(100 . "AcDbEntity")
    
13.      '(100 . "AcDbPolyline")
    
14.      (CONS 90 (LENGTH LST))
    
15.       )
    
16.       (MAPCAR '(LAMBDA (PT) (CONS 10 PT)) LST)
    
17.     )
    
18.   )
    
19. 
    
20.   (WHILE LOOP
    
21.     (SETQ GR   (GRREAD T 15 2)
    
22.           CODE (CAR GR)
    
23.           PT   (CADR GR)
    
24.     )
    
25.     (COND
    
26.       ((OR (= CODE 3)                        ; 鼠标左击                        
    
27.            (= CODE 11)                        ; 鼠标右击
    
28.            (= CODE 25)
    
29.        )
    
30.        (SETQ LOOP NIL)
    
31.       )
    
32.       ((= CODE 5)                        ; 鼠标移动
    
33.        (SETQ PX
    
34.               (CAR (VL-SORT
    
35.                      LST
    
36.                      (FUNCTION (LAMBDA (E1 E2)
    
37.                                  (< (DISTANCE E1 PT) (DISTANCE E2 PT))
    
38.                                )
    
39.                      )
    
40.                    )
    
41.               )
    
42.        )
    
43.        (IF E1
    
44.          (ENTDEL E1)
    
45.        )
    
46.        (SETQ
    
47.          E1 (ENTMAKEX (LIST '(0 . "LINE") (CONS 10 PT) (CONS 11 PX)))
    
48.        )
    
49.       )
    
50.     )
    
51.   )
    
52. )

复制代码

给个币呗

包哥

ssyfeng 发表于 2023-1-24 11:13
看看是不是这个效果：

非常感谢，就是这个效果

包哥

liuhe 发表于 2023-1-24 11:39
给个币呗

谢谢大佬，这个效果也很好