求前辈帮忙指点一下这个小功能如何实现（grread函数没学透），万分感谢

包哥

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

xyp1964

1. (defun c:tt ()
   
2.   (defun PlPtn (s1)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1))))
   
3.   (if (and (setq p0 (getpoint "\n基点<退出>: "))
   
4.            (setq p1 (getcorner p0 "\n对角点<退出>: "))
   
5.       )
   
6.     (progn
   
7.       (setvar "osmode" 0)
   
8.       (command "Rectang" p0 p1)
   
9.       (setq s1 (entlast)
   
10.             ptn (PlPtn s1)
    
11.             mode t
    
12.       )
    
13.       (while mode
    
14.         (setq gd15 (grread t 15 0)
    
15.               cd (car gd15)
    
16.         )
    
17.         (cond ((or (= cd 2) (= cd 3) (= cd 25)) (setq mode nil))
    
18.               ((= cd 5)
    
19.                (redraw)
    
20.                (setq pt (cadr gd15)
    
21.                      ptn (vl-sort ptn '(lambda (x y) (< (distance pt x) (distance pt y))))
    
22.                      p1 (car ptn)
    
23.                )
    
24.                (Grvecs (list 1 pt p1))
    
25.               )
    
26.         )
    
27.       )
    
28.       (redraw)
    
29.       (command "Line" pt p1 "")
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )

(defun c:tt ()<br />   (defun PlPtn (s1)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1))))<br />   (if (and (setq p0 (getpoint "\n基点<退出>: "))<br />            (setq p1 (getcorner p0 "\n对角点<退出>: "))<br />       )<br />     (progn<br />       (setvar "osmode" 0)<br />       (command "Rectang" p0 p1)<br />       (setq s1 (entlast)<br />             ptn (PlPtn s1)<br />             mode t<br />       )<br />       (while mode<br />         (setq gd15 (grread t 15 0)<br />               cd (car gd15)<br />         )<br />         (cond ((or (= cd 2) (= cd 3) (= cd 25)) (setq mode nil))<br />               ((= cd 5)<br />                (redraw)<br />                (setq pt (cadr gd15)<br />                      ptn (vl-sort ptn '(lambda (x y) (< (distance pt x) (distance pt y))))<br />                      p1 (car ptn)<br />                )<br />                (Grvecs (list 1 pt p1))<br />               )<br />         )<br />       )<br />       (redraw)<br />       (command "Line" pt p1 "")<br />     )<br />   )<br />   (princ)<br /> )

xyp1964

包哥

xyp1964 发表于 2023-1-24 18:33

感谢院长

masterlong

盲猜动态云线

chslwj521

可以哦，最近点这个有用

金鹅起飞

感谢xyp1964分享插件，向你学习