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

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

这是我在一本书上找到的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

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

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

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

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

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

(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 :")
        URPLLP
        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

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

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

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

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

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

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

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

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

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

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

几世纪的东西都能翻出来，拜服。
页: [1]
查看完整版本: 这是我在一本书上找到的LISP程序，可以在画矩形的同时显示出边长和面积[求助]