;This is very lengthy program for one side offset to closed or open polygon (equal horizontal distance )up to 6 stages upper or lower , we required multiple side polygon to be offset simultaneous with varied horizontal distance with respect to horizon of vertex.
(defun dang (x / cosx) (setq cosx (cos x)) (if (/= cosx 0) (/ (sin x) cosx))
)
(defun c:pit ()
(prompt "This program is written by ksr.anjaneyulu")
(initget 7)
(setq no (getint "\nenter proposed no. of benchs <1 2 3 4 5 6>: "))
(setq slp (getangle "\nenter bench slope: "))
(setq ht (getint "\nenter proposed bench height: "))
(setq dist (* ht (/ 1 (dang slp))))
(setq wi (getreal "\nenter proposed bench width: "))
(setq elevation (getreal "\nenter proposed bench elevation <0>: ")) ; must enter 0
(setq vertical (getint "\nenter proposed bench vertical diff < -3 -5 -10 -15 30 >: "))
(setq dstlst (list dist wi))
(setq ve (list elevation vertical))
(setq ve1 (+ elevation vertical))
(setq d1 (car dstlst))
(setq d2 (cadr dstlst))
(if (= vertical -3) (setq mmm(list -3 -3 -6 -6 -9 -9 -12 -12 -15 -15 -18 -18)))
(if (= vertical -5) (setq mmm(list -5 -5 -10 -10 -15 -15 -20 -20 -25 -25 -30 -30)))
(if (= vertical -10) (setq mmm(list -10 -10 -20 -20 -30 -30 -40 -40 -50 -50 -60 -60)))
(if (= vertical -15) (setq mmm(list -15 -15 -30 -30 -45 -45 -60 -60 -75 -75 -90 -90)))
(if (= vertical 30) (setq mmm(list 30 30 60 60 90 90 120 120 150 150 180 180)))
(if (= no 1)
(setq dstlst1 (list d1 (+ d1 d2))))
(if (= no 2)
(setq dstlst1 (list d1 (+ d1 d2) (+ d1 d2 d1) (+ d1 d2 d1 d2))))
(if (= no 3)
(setq dstlst1 (list d1 (+ d1 d2) (+ d1 d2 d1) (+ d1 d2 d1 d2) (+ d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2))))
(if (= no 4)
(setq dstlst1 (list d1 (+ d1 d2) (+ d1 d2 d1) (+ d1 d2 d1 d2) (+ d1 d2 d1 d2 d1)
(+ d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2))))
(if (= no 5)
(setq dstlst1 (list d1 (+ d1 d2) (+ d1 d2 d1) (+ d1 d2 d1 d2) (+ d1 d2 d1 d2 d1)
(+ d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1 d2))))
(if (= no 6)
(setq dstlst1 (list d1 (+ d1 d2) (+ d1 d2 d1) (+ d1 d2 d1 d2) (+ d1 d2 d1 d2 d1)
(+ d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1 d2) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1 d2 d1) (+ d1 d2 d1 d2 d1 d2 d1 d2 d1 d2 d1 d2))))
(setq ss2 (car (entsel "\npick pit boundary: ")))
;ent(car ss2)
;elist(entget ent)
;eless2(assoc 38 elist)
(setq p3 (getpoint "\npick point on middle of the boundary: "))
(setq count 0)
(repeat (length dstlst1)
(command "offsetfeature" (nth count dstlst1) ss2 p3 (nth count mmm) "")
(setq count (1+ count))
;----------------------------------------------
;(setq ve1(- ve1 10))
;---------------------------------------------
)
(setq ss2 nil dstlst1 nil
)
(defun pboun ()
(command "area" "e" obj) (setq darea (getvar "area"))
(ssdel obj ss1)
)
(defun elim (ele lst)
(apply 'append (subst nil (list ele) (mapcar 'list lst))))
(defun adde (ele lst / tmp)
(if (= (type lst) 'SYM) (setq tmp lst lst (eval tmp)))
(setq lst (cond ((member ele lst) lst)
(t (cons ele lst))))
(if tmp (set tmp lst) lst)
)
(DEFUN C:dvol ()
(setq cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "plinegen" (getvar "plinegen"))
(setq darea 0)
(prompt "\nSelect only the dump boundary lines: ")
(setq ss1 (ssget))
(setq sd (sslength ss1)) (while (> (sslength ss1) 0)
(setq obj (ssname ss1 0))(setq ent (entget obj))
(setq et (cdr (assoc '0 ent)))
(cond ((= et "LWPOLYLINE") (pboun)) ((= et "POLYLINE") (pboun)) ((or (/= et "LWPOLYLINE") (/= et "POLYLINE"))(ssdel obj ss1)
)
)
(setq ara2 (append ara2 (list darea)))
(setq first (last ara2))
)
(setq ara2 (elim (last ara2) ara2))
(setq ara2 (adde first ara2))
(setq dump1 (* (/ (+ (nth 0 ara2) (nth 1 ara2)) 2) 30)
dump2 (* (/ (+ (nth 2 ara2) (nth 3 ara2)) 2) 30)
dump3 (* (/ (+ (nth 4 ara2) (nth 5 ara2)) 2) 30)
dump4 (* (/ (+ (nth 6 ara2) (nth 7 ara2)) 2) 30))
(setq dump dump1 dump (+ dump1 dump2) dump (+ dump1 dump2 dump3) dump (+ dump1 dump2 dump3 dump4)
)
(princ (strcat "The volume of dump = " (rtos (/ dump 1.2 1000000) 2 2) " " "Mbum")) (terpri)
(princ)
(setq ara2 nil)
(setq dump nil)
(setq dump1 nil dump2 nil dump3 nil ss1 nil dump4 nil)
)
)