马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
 - (defun c:XDTB_FangPo ( / ept1 ept2 height pts spt val)
- (if (and
- (setq spt (getpoint "放坡起点<退出>:"))
- (setq height (getdist spt "\n输入坡高<退出>:"))
- )
- (progn
- (if (not #xd_var_global_fangpo_scl)
- (setq #xd_var_global_fangpo_scl 2.0)
- )
- (if (setq val (getreal (xdrx_prompt "\n1:? 放坡<"
- #xd_var_global_fangpo_scl ">:" t
- )
- )
- )
- (setq #xd_var_global_fangpo_scl val)
- )
- (if (not #xd_var_global_fangpo_width)
- (setq #xd_var_global_fangpo_width 100.0)
- )
- (if (setq val (getreal (xdrx_prompt "\n平台宽度<"
- #xd_var_global_fangpo_width ">:" t
- )
- )
- )
- (setq #xd_var_global_fangpo_width val)
- )
- (if (not #xd_var_global_fangpo_num)
- (setq #xd_var_global_fangpo_num 1)
- )
- (if (setq val (getint (xdrx_prompt "\n输入放坡数<"
- #xd_var_global_fangpo_num ">:" t
- )
- )
- )
- (setq #xd_var_global_fangpo_num val)
- )
- (setq pts nil)
- (repeat #xd_var_global_fangpo_num
- (setq ept1 (mapcar
- '+
- spt
- (list (* height #xd_var_global_fangpo_scl) height 0.0)
- )
- ept2 (mapcar
- '+
- ept1
- (list #xd_var_global_fangpo_width 0.0 0.0)
- )
- )
- (setq pts (cons ept2 (cons ept1 (cons spt pts))))
- (setq spt ept2)
- )
- (xdrx_polyline_make (xd::pnts:ucs2wcs (reverse pts)))
- )
- )
- (princ)
- )
|