这是我在一本书上找到的LISP程序，可以在画矩形的同时显示出边长和面积[求助]

dgh · 发表于 2003-2-12 21:01:00

这是我在一本书上找到的LISP程序，可以在画矩形的同时显示出边长和面积，但总提示错误。哪位高手帮我调试一下，谢谢！
(defun drawbox (pt1 pt2 / pt3 pt4)
   (grdraw pt1
      (setq pt3 (list (car pt2) (cadr pt1))) -1)
   (grdraw pt1
      (setq pt4 (list (car pt1) (cadr pt2))) -1)
   (grdraw pt3 pt2 -1)
   (grdraw pt4 pt2 -1))
(defun C:ROOM (/ llp p loop urp source pt lrp ulp)
   (initget 1)
   (setp llp (getpoint "\nFirst point :") urp llp loop t)
   (drawbox llp urp)
   (prompt "\nScond point :")
   (while loop
            (setq urp1 (grread t))
            (setq source (car urp1) pt (cadr urp1))
            (cond
            ((and (= source 5)
               (or (/= (car urp) (car pt))
                  (/= (cadr urp) (cadr pt))
               )
            )
      (progn
            (drawbox llp utp)
            (setq w (- (car urp) (car llp)))
            (setq l (- (cadr urp) (cadr llp)))
            (setq sm (* (/ w 1000.0) (/ l 1000.0)))
            (setq x (strcat (rtos w 2 0) "x"
                           (rtos l 2 0) "A=" (rtos (ads sm) 2 2)))
            (grtext -2 x)
      )
      (drawbox llp pt)
      (setp urp pt)
      )
   ((or (= source 3)
      (and (= source 2) (or (= pt 13) (= pt 32))))
      (drawbox llp urp)
      (setq loop nil))))
      (setq lrp (list (car urp) (cadr llp)))
      (setq ulp (list (car llp) (cadr uru)))
   (command "pline" llp "w" 240 240 lrp urp ulp "c")
)

mccad · 发表于 2003-2-13 17:09:00

mccad · 发表于 2003-2-13 17:10:00

龙龙仔 · 发表于 2003-2-14 08:20:00

(defun DRAWBOX (PT1 PT2 / PT3 PT4)
  (grdraw PT1
   (setq PT3 (list (car PT2) (cadr PT1)))
   -1
  )
  (grdraw PT1
   (setq PT4 (list (car PT1) (cadr PT2)))
   -1
  )
  (grdraw PT3 PT2 -1)
  (grdraw PT4 PT2 -1)
)
(defun C:ROOM (/ LLP P LOOP URP SOURCE PT LRP ULP)
  (initget 1)
  (setq LLP  (getpoint "\nFirst point :")
URP  LLP
LOOP t
  )
  (DRAWBOX LLP URP)
  (prompt "\nScond point :")
  (while LOOP
(setq URP1 (grread t 1 0))
(setq SOURCE (car URP1)
   PT    (cadr URP1)
)
(cond
   ((and (= SOURCE 5)
      (or (/= (car URP) (car PT))
(/= (cadr URP) (cadr PT))
      )
   )
   (progn
   (DRAWBOX LLP URP)
   (setq W (- (car URP) (car LLP)))
   (setq L (- (cadr URP) (cadr LLP)))
   (setq SM (* (/ W 10.0) (/ L 10.0)))
   (setq X (strcat (rtos (abs (/ W 10)) 2 1)
   "cm*"
   (rtos (abs (/ L 10)) 2 1)
   "cm 面积= "
   (rtos (abs SM) 2 2)
   "cm^2"
   )
   )
              ;;(grtext 1 X)
   (setvar "MODEMACRO" X)
   )
   (DRAWBOX LLP PT)
   (setq URP PT)
   )
   ((or (= SOURCE 3)
   (and (= SOURCE 2) (or (= PT 13) (= PT 32)))
   )
   (DRAWBOX LLP URP)
   (setq LOOP NIL)
   )
)
  )
  (setq LRP (list (car URP) (cadr LLP)))
  (setq ULP (list (car LLP) (cadr URP)))
  (command "pline" LLP LRP URP ULP "c")
)

dgh · 发表于 2003-2-15 22:26:00

谢谢！谢谢高手！不过这个程序和我预想的有一些差别，我想边长的单位应是毫米，面积的单位应是平方米。这样符合建筑绘图习惯，另外如果能同时绘出墙厚，显示出轴线面积和使用面积，就是一个非常好的草图绘制工具了！

Ea · 发表于 2003-2-16 14:38:00

找Grread应用的例子很久了，谢谢。
Drawbox中的grdraw还可以用Grvecs的，配合Matrix比Grdraw更强大。

龙龙仔 · 发表于 2003-2-17 12:25:00

Ea · 发表于 2003-2-20 18:51:00

尝试着写了，发现个问题鼠标移动后没法消除前面画的就放弃了。
不过找到了一个VLISP实现动态缩放、移动、旋转的方法，用Grread跟踪点，然后构造跟踪点相对基点的矩阵（平移、旋转或缩放），然后用Transformby作用实体。

yxh1202 · 发表于 2012-3-10 22:55:58

路过，学习了。这个帖子还得到明总的指点，高兴啊

soly2006 · 发表于 2012-3-10 23:15:05

几世纪的东西都能翻出来，拜服。

账号		自动登录	找回密码
密码			注册

这是我在一本书上找到的LISP程序，可以在画矩形的同时显示出边长和面积[求助]

有些字母没拼对：setp->setq, ads->abs, utp->urp

还有，程序好象没有显示面积及财长的句子

修改..OK.可以在画矩形的同时显示出边长和面积

谢谢！谢谢高手！不过......

Drawbox中的grdraw还可以用Grvecs的，配合Matrix比Grdraw更强大。

配合Matrix比Grdraw(有例子嗎?)

没有，不过找到个用VLSP实现动态移动旋转缩放的方法。