luyu9635 发表于 2009-9-6 22:02:00

[原创]动态矩形

<p>小程序，简单的动态</p>

hnfsf 发表于 2009-9-7 00:33:00

<p>很不错，支持源码</p><p>修改一下，按50的模数，便于画结构构件截面</p><p><font face="Courier New" color="#800080">;;luyu9635动态矩形<br/></font></p><p>(defun c:rg (/ gr grr p1 p2 p3 p4 po pt px pxy py text textent x z)<br/>&nbsp; (setq pt (getpoint "\n指定第一个角点:") z t)<br/>&nbsp; (prompt "\n指定另一个角点:")<br/>&nbsp; (while z<br/>&nbsp;&nbsp;&nbsp; (initget 128)<br/>&nbsp;&nbsp;&nbsp; (setq grr (grread t 4 1));请求输入<br/>&nbsp;&nbsp;&nbsp; (setq gr (car grr) po (cadr grr))<br/>&nbsp;&nbsp;&nbsp; (cond<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((= gr 5);移动时<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq px (* 50 (fix (/ (- (car po) (car pt)) 50)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; py (* 50 (fix (/ (- (cadr po) (cadr pt)) 50)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pxy (list (abs px) (abs py)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq p1 (list (car pt) (cadr pt))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; p2 (list (car pt) (+ py (cadr pt)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; p3 (list (+ px (car pt)) (+ py (cadr pt)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; p4 (list (+ px (car pt)) (cadr pt)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (redraw)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (grvecs (list 7 p1 p2 7 p2 p3 7 p3 p4 7 p4 p1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if text<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq textent (subst (cons 1 (vl-princ-to-string pxy)) (assoc 1 textent) textent))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq textent (subst (cons 10 po) (assoc 10 textent) textent))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmod textent)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string pxy)) (cons 10 po) (cons 40 100)(cons 41 0.7) (cons 50 0)(cons 62 2)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq text (entlast)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textent (entget text))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((or (= gr 3);左击<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (equal grr '(2 32));空格<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (equal grr '(2 13));回车<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (equal grr' (11 0)));右击<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq z nil)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>&nbsp; (redraw)<br/>&nbsp; (entmake (append' ((0 . "lwpolyline") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) ) <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mapcar '(lambda (x) (cons 10 x))(list p1 p2 p3 p4))))<br/>&nbsp; (if text (entdel text)<br/>&nbsp; )<br/>&nbsp; (princ)<br/>)</p>

懸懸懸 发表于 2021-2-11 17:23:22

对啊   需要能输入的吗:(不然只是好看{:1_1:}

啵浪鼓 发表于 2009-9-16 01:38:00

<p>谢谢楼主,能否再完善一下:</p><p>1,程序按Esc键,文字还是留在屏幕上不消失</p><p>2,小数点位太长,仅保留2位小数如何?</p><p>3,最重要的一点,能否让用户输入长宽就能按用户输入的数据来画矩形的尺寸</p><p>下面是我常用的矩形程序,主要是没有动态显示,每次输数据时看世界cad的自动坐标不好用,所以想用你的程序加入上面3点的效果!</p><p>(defun c:rec ()<br/>&nbsp; (prompt "矩形绘制")<br/>&nbsp; (setq m:err *error* *error* *merr*)<br/>&nbsp; (setvar "cmdecho" 0)<br/>&nbsp; (setq OS (getvar "osmode"))<br/>&nbsp;&nbsp;(while(SETQ PT1(GETPOINT "\n指定起始位置或输入数值/&lt;退出&gt;: "))<br/>&nbsp; (initget 128)<br/>&nbsp; (setq pt2(GETCORNER PT1 "\n对角点位或矩形宽/&lt;退出&gt;:"))<br/>&nbsp; (command "rectang" pt1)<br/>&nbsp; (cond<br/>&nbsp;&nbsp;&nbsp; ((not pt2)(command)(exit))<br/>&nbsp;&nbsp;&nbsp; ((listp pt2)(command pt2))<br/>&nbsp;&nbsp;&nbsp; ((distof pt2) (setvar "osmode" 0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command (strcat "@" pt2 "," (rtos(getdist "\n矩形高:")))))<br/>&nbsp; ))<br/>(setvar "osmode" OS)<br/>(setq *error* m:err m:err nil)<br/>(princ)<br/>)</p>

zhaozwf 发表于 2009-9-16 09:22:00

<p>不能输入数值，看着怪着好看，不太实用</p>

啵浪鼓 发表于 2009-9-16 18:17:00

是啊﹐只是好看不太實用﹐能輸數字就好了

啵浪鼓 发表于 2009-9-21 01:03:00

有没有人能将这个程序在原有的基础上加上用户输入长*宽的功能呀

luyu9635 发表于 2009-9-23 00:39:00

啵浪鼓发表于2009-9-16 18:17:00static/image/common/back.gif是啊﹐只是好看不太實用﹐能輸數字就好了

<p>请参照动态拉伸，自己修改一下</p>

434939575 发表于 2011-9-23 17:51:39

高手！

zyhandw 发表于 2011-11-22 15:30:07

很好啊，学习，学习，在学习！！！

pxt2001 发表于 2011-11-23 10:59:38

luyu9635 发表于 2009-9-23 00:39 static/image/common/back.gif
请参照动态拉伸，自己修改一下

希望楼主能继续完善功能：动态输入矩形宽、高。
页: [1] 2
查看完整版本: [原创]动态矩形