请教：CAD中如何用lisp画四棱台？

挖个坟，二楼的代码怎么用啊，我保存成lsp文件子么显示错误: 输入的列表有缺陷。

想请你把它改成输入上顶面的中点,
那你就把"顶面矩形"的长度和宽度跟"底面矩形"互换就行了

你写的这个程序不错,我试了一下可行.你的程序在实际画图时提供的下底面的中点,我想请你把它改成输入上顶面的中点,行不?急切等待

你提供的网页打不开啊,我的QQ是354296003,多谢你的回答

更多信息,我发布在这个贴子里面,里面有详细的解释和动画
http://acad.net.cn/viewthread.php?tid=420&page=1&extra=page%3D1

具体代码如下:

;;;tftj土方体积
(defun c:tftj (/ BOX H LB LT OBJ OSM P PB1 PB2 PB3
PB4 PB_X PB_Y PT1 PT2 PT3 PT4 PT_X PT_Y PT_Z SB
ST VOL WB WT
)
;;语法：(udist 1 "" "\n\t距离" dist1 (list 0 0),距离输入格式化.
(defun udist (bit kwd msg def bpt / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def) ">:")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ":"))
)
(initget bit kwd)
(setq inp (if bpt
(getdist msg bpt)
(getdist msg)
)
)
(if inp
inp
def
)
)
;;主程序-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
(command ".-view" "_top") ;_俯视
(setq osm (getvar "osmode"))
(if (setq p (getpoint "\n>>>指定矩形的中点<退出>:"))
(progn
(setq lt (udist 1 "" ">>>指定顶面矩形的长度" 3000 p))
(setq wt (udist 1 "" ">>>指定顶面矩形的宽度" 2200 p))
(setq lb (udist 1 "" ">>>指定底面矩形的长度" 2400 p))
(setq wb (udist 1 "" ">>>指定底面矩形的宽度" 1400 p))
(setq h (udist 1 "" ">>>指定高度" 1000 p))
(setvar "osmode" 0)
;;顶面矩形-*-*-*-*-*-*-*-*-*-*-
(setq pt_x (car p))
(setq pt_y (cadr p))
(setq pt_z (+ (caddr p) h))
(setq pt1 (list (- pt_x (* 0.5 lt)) (+ pt_y (* 0.5 wt)) pt_z) ;_左上角的点
pt2 (list (- pt_x (* 0.5 lt)) (- pt_y (* 0.5 wt)) pt_z) ;_左下角的点
pt3 (list (+ pt_x (* 0.5 lt)) (- pt_y (* 0.5 wt)) pt_z) ;_右下角的点
pt4 (list (+ pt_x (* 0.5 lt)) (+ pt_y (* 0.5 wt)) pt_z) ;_右上角的点
)
(command "_.pline" "non" pt1 "non" pt2 "non" pt3 "non" pt4 "c")
(setq st (entlast))
;;底面矩形-*-*-*-*-*-*-*-*-*-*-
(setq pb_x (car p))
(setq pb_y (cadr p))
(setq pb1 (list (- pb_x (* 0.5 lb)) (+ pb_y (* 0.5 wb))) ;_左上角的点
pb2 (list (- pb_x (* 0.5 lb)) (- pb_y (* 0.5 wb))) ;_左下角的点
pb3 (list (+ pb_x (* 0.5 lb)) (- pb_y (* 0.5 wb))) ;_右下角的点
pb4 (list (+ pb_x (* 0.5 lb)) (+ pb_y (* 0.5 wb))) ;_右上角的点
)
(command "_.pline" "non" pb1 "non" pb2 "non" pb3 "non" pb4 "c")
(setq sb (entlast))
(command ".-view" "_swiso") ;_西南等测轴
;;拉伸矩形
(if (> lt lb)
(progn
(command "._extrude" st "" (- h) "0")
(setq box (entlast))
(command ".erase" sb "")
)
(progn
(command "._extrude" sb "" h "0")
(setq box (entlast))
(command ".erase" st "")
)
)
(command "._slice" box "" "3" pb1 pb2 pt1 pb3)
(command "._slice" box "" "3" pb2 pb3 pt2 pb4)
(command "._slice" box "" "3" pb3 pb4 pt3 pt1)
(command "._slice" box "" "3" pb4 pb1 pt4 pt2)
(setq obj (vlax-ename->vla-object box))
(setq vol (rtos (vla-get-Volume obj) 2))
(princ "\n>>>土方的体积是: ")
(princ vol)
)
)
(setvar "osmode" osm)
(princ)
)