[原创]动态矩形

luyu9635

小程序，简单的动态

hnfsf

很不错，支持源码

修改一下，按50的模数，便于画结构构件截面

;;luyu9635动态矩形

(defun c:rg (/ gr grr p1 p2 p3 p4 po pt px pxy py text textent x z)
  (setq pt (getpoint "\n指定第一个角点:") z t)
  (prompt "\n指定另一个角点:")
  (while z
    (initget 128)
    (setq grr (grread t 4 1));请求输入
    (setq gr (car grr) po (cadr grr))
    (cond
      ((= gr 5);移动时
        (setq px (* 50 (fix (/ (- (car po) (car pt)) 50)))
              py (* 50 (fix (/ (- (cadr po) (cadr pt)) 50)))
              pxy (list (abs px) (abs py)))
        (setq p1 (list (car pt) (cadr pt))
              p2 (list (car pt) (+ py (cadr pt)))
              p3 (list (+ px (car pt)) (+ py (cadr pt)))
              p4 (list (+ px (car pt)) (cadr pt)))
        (redraw)
        (grvecs (list 7 p1 p2 7 p2 p3 7 p3 p4 7 p4 p1))
        (if text
          (progn
            (setq textent (subst (cons 1 (vl-princ-to-string pxy)) (assoc 1 textent) textent))
            (setq textent (subst (cons 10 po) (assoc 10 textent) textent))
            (entmod textent)
          )
          (progn
            (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)))
            (setq text (entlast)
                  textent (entget text))
          )
        )
      )
      ((or (= gr 3);左击
         (equal grr '(2 32));空格
         (equal grr '(2 13));回车
         (equal grr' (11 0)));右击
        (setq z nil)
      )
    )
  )
  (redraw)
  (entmake (append' ((0 . "lwpolyline") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) )
              (mapcar '(lambda (x) (cons 10 x))(list p1 p2 p3 p4))))
  (if text (entdel text)
  )
  (princ)
)

懸懸懸

对啊   需要能输入的吗  不然只是好看

啵浪鼓

谢谢楼主,能否再完善一下:

1,程序按Esc键,文字还是留在屏幕上不消失

2,小数点位太长,仅保留2位小数如何?

3,最重要的一点,能否让用户输入长宽就能按用户输入的数据来画矩形的尺寸

下面是我常用的矩形程序,主要是没有动态显示,每次输数据时看世界cad的自动坐标不好用,所以想用你的程序加入上面3点的效果!

(defun c:rec ()
  (prompt "矩形绘制")
  (setq m:err *error* *error* *merr*)
  (setvar "cmdecho" 0)
  (setq OS (getvar "osmode"))
  (while(SETQ PT1(GETPOINT "\n指定起始位置或输入数值/<退出>: "))
  (initget 128)
  (setq pt2(GETCORNER PT1 "\n对角点位或矩形宽/<退出>:"))
  (command "rectang" pt1)
  (cond
    ((not pt2)(command)(exit))
    ((listp pt2)(command pt2))
    ((distof pt2) (setvar "osmode" 0)
                  (command (strcat "@" pt2 "," (rtos(getdist "\n矩形高:")))))
  ))
(setvar "osmode" OS)
(setq *error* m:err m:err nil)
(princ)
)

zhaozwf

不能输入数值，看着怪着好看，不太实用

啵浪鼓

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

啵浪鼓

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

luyu9635

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

请参照动态拉伸，自己修改一下

434939575

高手！

zyhandw

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

pxt2001

luyu9635 发表于 2009-9-23 00:39
请参照动态拉伸，自己修改一下

希望楼主能继续完善功能：动态输入矩形宽、高。