;|
Slope Line
- Select Top slope
- Select bottom slope
- Select Color By Dialog
- Enter Line slope distance
|;
(defun
slope-line (/ is-on-pl? talud_boven talud_onder
afstand
afstand_totaal
count p1 p2 colr
)
(defun
is-on-pl? (ename pkt /)
(vl-catch-all-apply
'vlax-curve-getdistatpoint
(list
ename
pkt
) ;_ end of list
) ;_ end of vlax-curve-getdistatpoint
pkt
)
;_ end defun
(vl-load-com)
(if (and (setq talud_boven (car (entsel
"\nSelect top slope: ")))
(setq talud_onder (car (entsel "\nSelect
bottom slope: ")))
(setq colr (acad_colordlg 8))
) ;_ end of and
(progn
;;-------------------------------------------------------
(or afstand (setq afstand 10.0))
(setq afstandtemp
(getDist (strcat "Line slope
distance <"
(rtos afstand 2 2)
">: "
) ;_ strcat
) ;_ getint
) ;_ setq
(and afstandtemp (setq afstand afstandtemp))
;;-------------------------------------------------------
;(setq colr 8)
(setq afstand_totaal 0)
(setq count 0)
(setq p1 (vlax-curve-getstartpoint
talud_boven
) ;_ end of
vlax-curve-getstartpoint
) ;_ end of setq
(while p1
(if (equal (/ count 2.0)
(fix (/ count 2.0)) 0.001)
(setq p2
(vlax-curve-getclosestpointto
talud_onder
p1
) ;_
end of vlax-curve-getclosestpointto
) ;_ end of setq
(setq p2
(mapcar
'(lambda (x) (/ x 2))
(mapcar
'+
p1
(vlax-curve-getclosestpointto
talud_onder
p1
)
;_ end of vlax-curve-getclosestpointto
) ;_
end of mapcar
) ;_ end of
mapcar
) ;_ end of setq
) ;_ end of if
(entmake
(list '(0 .
"LINE")
(cons
10 p1)
(cons
11 p2)
;'(62
. 1) ; standaard colour
(cons
62 colr) ; colour by dialog
) ;_ end of list
) ;_ end of entmake
(if (not
(vl-catch-all-error-p
(setq
p1
(is-on-pl?
talud_boven
(vl-catch-all-apply
'vlax-curve-getpointatdist
(list talud_boven
(if (<
(setq afstand_totaal
(+
afstand_totaal afstand)
)
(vlax-curve-getdistatpoint
talud_boven
(vlax-curve-getendpoint talud_boven)
)
)
afstand_totaal
nil
) ;_ end of if
) ;_ end of list
) ;_ end of
vl-catch-all-apply
) ;_
end of is-on-pl?
) ;_ end of
setq
) ;_ end of
vl-catch-all-error-p
) ;_ end of not
p1
(setq p1 nil)
) ;_ end of if
(setq count (1+ count))
) ;_ end of while
) ;_ end of progn
) ;_ end of if
(princ)
)
;_ end of defun
(defun
c:spl ()
(slope-line)
)
(prompt
"\nEnter SPL to Start Slope Line.")
