请教：如何用grread动态画一个固定宽高比（比如宽：高=2）的矩形？

mandala

请教：如何用grread动态画一个固定宽高比的矩形？
如：一个宽：高=2：1的矩形

xyp1964

1. (defun c:tt () ;tt(动态宽高比=2矩形)
   
2.   (while (setq p0 (getpoint "\n基点<退出>: "))
   
3.     (setq mode t)
   
4.     (while mode
   
5.       (setq code (grread nil 15 0) cd (car code))
   
6.       (cond ((member cd '(2 3 25)) (setq mode nil))
   
7.             ((= cd 5)
   
8.              (redraw)
   
9.              (setq pt (cadr code)
   
10.                    dx (- (car pt) (car p0))
    
11.                    dy (* dx 0.5)
    
12.                    p2 (list (car pt) (+ (cadr p0) dy))
    
13.                    p1 (list (car p2) (cadr p0))
    
14.                    p3 (list (car p0) (cadr p2))
    
15.              )
    
16.              (grvecs (list 1 p0 p1 1 p1 p2 1 p2 p3 1 p3 p0))
    
17.             )
    
18.       )
    
19.     )
    
20.     (redraw)
    
21.     (command "Rectang" "non" p0 "non" p2)
    
22.   )
    
23.   (princ)
    
24. )

(defun c:tt () ;tt(动态宽高比=2矩形)<br />   (while (setq p0 (getpoint "\n基点<退出>: "))<br />     (setq mode t)<br />     (while mode<br />       (setq code (grread nil 15 0) cd (car code))<br />       (cond ((member cd '(2 3 25)) (setq mode nil))<br />             ((= cd 5)<br />              (redraw)<br />              (setq pt (cadr code)<br />                    dx (- (car pt) (car p0))<br />                    dy (* dx 0.5)<br />                    p2 (list (car pt) (+ (cadr p0) dy))<br />                    p1 (list (car p2) (cadr p0))<br />                    p3 (list (car p0) (cadr p2))<br />              )<br />              (grvecs (list 1 p0 p1 1 p1 p2 1 p2 p3 1 p3 p0))<br />             )<br />       )<br />     )<br />     (redraw)<br />     (command "Rectang" "non" p0 "non" p2)<br />   )<br />   (princ)<br /> )

菜卷鱼

画矩形动态用不着这么复杂啊，getcorner 啊

mandala

xyp1964 发表于 2020-11-10 23:23

非常感谢！

mandala

菜卷鱼 发表于 2020-11-11 08:41
画矩形动态用不着这么复杂啊，getcorner 啊

getcorner 能固定宽高比吗

菜卷鱼

mandala 发表于 2020-11-24 19:00
getcorner 能固定宽高比吗

你好是个钻石会员

1. (defun c:tt (/ pt1 pt2 p-p p+p)
   
2.   (setq pt1 (getpoint "\n起始点:"))
   
3.   (initget 1)
   
4.   (setq pt2 (getcorner pt1 "\n大概结束点:"))
   
5.   (setq p-p (mapcar '- pt2 pt1))
   
6.   (if (>= (car p-p) (* 2 (cadr p-p)))
   
7.     (setq p+p (mapcar '+ pt1 (list (* 2 (cadr p-p)) (cadr p-p) 0.0)))
   
8.     (setq p+p (mapcar '+ pt1 (list (car p-p) (* 0.5 (car p-p)) 0.0)))
   
9.   )
   
10.   (setvar 'cmdecho 0)
    
11.   (command "Rectang" "non" pt1 "non" p+p)
    
12.   (setvar 'cmdecho 1)
    
13. )

(defun c:tt (/ pt1 pt2 p-p p+p)<br />   (setq pt1 (getpoint "\n起始点:"))<br />   (initget 1)<br />   (setq pt2 (getcorner pt1 "\n大概结束点:"))<br />   (setq p-p (mapcar '- pt2 pt1))<br />   (if (>= (car p-p) (* 2 (cadr p-p)))<br />     (setq p+p (mapcar '+ pt1 (list (* 2 (cadr p-p)) (cadr p-p) 0.0)))<br />     (setq p+p (mapcar '+ pt1 (list (car p-p) (* 0.5 (car p-p)) 0.0)))<br />   )<br />   (setvar 'cmdecho 0)<br />   (command "Rectang" "non" pt1 "non" p+p)<br />   (setvar 'cmdecho 1)<br /> )