CAD

开发平台：

MathCAD

PD坡道绘制.LSP：源码内容

							;   =========================================
;   |                坡道软件               |
;   |       Ver: 1.0      作者: 迟俊岭      |
;   =========================================
(defun *error*(st)
  (if (and (/= st "Function cancelled")
	   (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)
(defun C:pd( / old_err lay loop pt chang kuan ss pt1 pt2 pt3  
	       pt4 pt5 ang1 ang2 d a ang ptm)
  (setq old_err *error*)
  (setvar "CMDECHO" 0)
  (setq lay (getvar "clayer"))
  (command "layer" "m" "pd" "c" "y" "pd" "")
  (command "osnap" "nea")
  (setq loop T)
  (while loop
    (initget 1 "R")
    (setq pt (getpoint "nR参照点/<外墙线上任意一点(nea方式)>: "))
    (cond
      ((eq pt "R") (progn
		     (command "osnap" "int")
		     (setq pt (getpoint "n参照点(int方式): "))
		     (setq pt (getpoint pt "n相对坐标(格式:@X,Y或@长度<角度): "))
		     (setq loop nil)
		    ))
      (t (setq loop nil))
    )
  )
  (command "osnap" "non")
  (setq chang (getdist pt "n台阶长度(最上面的)<2000>: "))
  (if (null chang) (setq chang 2000.0)) 
  (setq kuan (getdist "n台阶宽度(最上面的)<1500>: "))
  (if (null kuan) (setq kuan 1500.0)) 
  (progn
    (setq ss (ssadd))
    (setq pt1 (polar pt (* pi 1.5) kuan))
    (setq pt2 (polar pt1 0 chang))
    (setq pt3 (polar pt2 (* pi 0.5) kuan))
    (command "pline" pt "w" "0" "0" pt1 pt2 pt3 "")
    (setq ss (ssadd (entlast) ss))
    (setq pt4 (polar pt 0 300))
    (setq pt5 (polar pt 0 (- chang 300)))
    (command "line" pt1 pt4 "")
    (setq ss (ssadd (entlast) ss))
    (command "line" pt2 pt5 "")
    (setq ss (ssadd (entlast) ss))
  )
  (setq ang1 (angle pt1 pt4))
  (setq ang2 (- pi ang1))
  (setq d (/ 120.0 (sin ang1)))
  (repeat (fix (/ kuan 120.0))
    (setq pt1 (polar pt1 ang1 d))
    (setq pt2 (polar pt2 ang2 d))
    (command "line" pt1 pt2 "")
    (setq ss (ssadd (entlast) ss))
  )
  (setq a (getstring "nY旋转/<N>: "))
  (if (/= a "")
    (progn
      (setq ang (getreal "n旋转角度<90>: "))
      (if (null ang) (setq ang 90))
      (command "rotate" ss "" pt ang)
    )
  )
  (setq a (getstring "nY移动/<N>: "))
  (if (/= a "")
    (progn
      (setq ptm (getpoint pt "n另一点: "))
      (command "move" ss "" pt ptm)
    )
  )
  (command "layer" "s" lay "")
  (redraw)(princ)
)

						