[转贴]：画柱截面LISP

szx025

;;;--------柱截面----------

(defun c:zjm (/ w h pt1 pt2 pt3 pt4 pt5)
       (setq olderr *error*
           *error* at_err)
(setq color_old (getvar "cecolor")) ;_记录cecolor系统变量
  (setvar "cecolor" "3") ;_把cecolor系统变量设为黄色
       (setq pt1 (getpoint "\n定位点:"))
       (setq w (getdist "\n柱宽:"))
       (setq h (getdist "\n柱高:"))
       (setq pt2 (polar pt1 0 (/ w 2)))
       (setq pt3 (polar pt1 pi (/ w 2)))
       (setq pt4 (polar pt2 (* 0.5 pi) (* 0.5 h)))
       (setq pt5 (polar pt3 (* 1.5 pi) (* 0.5 h)))
       (setvar "osmode" 0)
       (command "rectang" pt4 pt5 "")
       (command "hatch" "solid" "w" pt4 pt5"")
       (setvar "osmode" 33)
       (setq *error* olderr)
       (princ)
       )
本人写的一个小程序,每次都要输入柱宽\柱高,能否做到只输入一次,下次在用时,如柱宽\柱高同上次一样,就不用再次输入,直接回车就行

dwg001

试试看。
[PHP]
;;;--------画柱截面----------

;;-------
;;原作_by szx025 ，每次都要输入柱宽\柱高。希望达到目标：能否做到只输入一次,
;;下次在用时,如柱宽\柱高同上次一样,就不用再次;;输入,直接回车就行 。

;;-------
;;修改_by dwg001, 已达到目标。且能够连续、多次输入不同的断面的柱子。


(defun c:zjm (/  oldos color_old pt1 pt2 pt3 pt4 pt5)
  
(setq olderr *error*
*error* at_err)
(setq oldos (getvar "osmode"))  
(setq color_old (getvar "cecolor")) ;_记录cecolor系统变量
(setvar "cecolor" "3") ;_把cecolor系统变量设为黄色
(while (setq pt1 (getpoint "\n柱中心定位点:"))
(progn
(prompt "\n [柱宽:]")  
(setq        w             (if (null W_dist)
                       (getdist "\n 当前值为<>:")
                       (getdist (strcat "\n当前值为<" (rtos W_dist) ">:"))
                     )
        W_dist (if (null w)
                       W_dist
                       w
                     )
  )
(prompt "\n [柱高:]")
(setq        h             (if (null h_dist)
                       (getdist "\n 当前值为<>:")
                       (getdist (strcat "\n当前值为<" (rtos h_dist) ">:"))
                     )
        h_dist (if (null h)
                       h_dist
                       h
                     )
  )
(setq pt2 (polar pt1 0 (/ W_dist 2)))
(setq pt3 (polar pt1 pi (/ W_dist 2)))
(setq pt4 (polar pt2 (* 0.5 pi) (* 0.5 h_dist)))
(setq pt5 (polar pt3 (* 1.5 pi) (* 0.5 h_dist)))
(setvar "osmode" 0)
(command "rectang" pt4 pt5 "")
(command "hatch" "solid" "w" pt4 pt5 "")
(setvar "osmode" oldos)
)
(princ)
  )
(setvar "osmode" 33)
(setq *error* olderr)
(princ)
)
(prompt "\n [画柱截面程序已加载，启动命令：ZJM]")
(prompt "\n [原作_by szx025;  修改_by dwg001. 2007-02-28 ]")
[/PHP]

szx025

谢谢,问题解决,再次谢谢!
能否再帮忙看看昨天我发的另一贴<索引标注软件 >提出的问题
还有一小问题,程序完成后如何让颜色返回到随层