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

2007年08月27日 17:45:46

4楼

更多信息,我发布在这个贴子里面,里面有详细的解释和动画

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

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)

)

回复

举报

点赞