;|
Pick POLYLINE to Calculate the Slope
Create and Design by SONGKHRAN JONGKUL
June 2021
|;
(defun
tan (x) (/ (sin x)(cos x)))
(defun
arsin (x) (setq y (sqrt (- 1 (* x x)))) (atan x y))
(defun
arcos (x) (- (/ pi 2)(arsin x)))
(defun
rtod (x) (/ (* x 180) pi))
(defun
dtor (x) (* x (/ pi 180)))
(defun
C:slope ( / ent lst PT1);; x y z
(setq
old_cmdecho (getvar
"cmdecho")) ; cmdecho
(setq
old_osnap (getvar "osmode")) ;
osnap
(setq
old_layer (getvar "clayer"))
(setvar
"cmdecho" 0)
(setvar
"osmode" 0)
(setq
txth (getvar 'textsize))
(if
(not (tblsearch "LAYER" "SLOPE-TEXT" ));;<=== Layer Name
(command "._layer"
"_M" "SLOPE-TEXT" "_Color" 5 ""
"LType" "Continuous" "" "")
)
(command "._style" "SLOPE-TEXT" "RID_TE.shx" 1.00 1.00 0 "n" "n");;font name: RID_TE.shx
(setq ent (entsel "\nPick POLYLINE to calculate the slope:"))
(if
(and ent
(wcmatch (cdr (assoc 0 (entget
(setq ent (car ent))))) "*POLYLINE") ;all types
) ;and
(setq lst (PolyVert ent)) ;make list
)
(setq
lstlen (length lst)
st 0
sn 1
)
(repeat
lstlen
(setq p1 (nth st lst);;read point p1
p2 (nth sn lst);;read point p2
)
(if(or(> (cadr p1)(cadr p2))(<
(cadr p1)(cadr p2)))
(tri p1 p2)
)
(setq st (1+ st)
sn (1+ sn)
)
);repeat
;(print
lst)
(setvar
"cmdecho" old_cmdecho)
(setvar
"osmode" old_osnap)
(setvar
"clayer" old_layer)
(princ)
)
(princ
"\nEnter SLOPE to Start Calculate the Slope. ")
(princ)
(defun
PolyVert (POLY / par pt1 lst)
(vl-load-com)
(setq par
(if (vlax-curve-isClosed POLY)
(vlax-curve-getEndParam
POLY) ; else
(1+ (vlax-curve-getEndParam
POLY))
)
)
(while (setq pt1
(vlax-curve-getPointAtParam POLY (setq par (- par 1))))
(setq lst (cons pt1 lst))
)
) ; return lst
(defun
tri (p1 p2 /) ;;calculate slope and draw triangle
(setq
ang (angle p1 p2)
trih (* txth 1.50)
)
(setq
mp (polar p1 ang (/ (distance p1 p2) 2.0)))
(setq
pta1 (polar mp (dtor 270.0) trih))
(if(<
(cadr p1) (cadr p2))
(setq Xdis (- (car p2)(car p1))
Ydis (- (cadr p2)(cadr p1))
)
(setq Xdis (- (car p2)(car p1))
Ydis (- (cadr p1)(cadr p2))
)
)
(setq
angsl (rtod(atan(/ Ydis Xdis)))
perc (* (/ Ydis Xdis) 100)
ratio (/ 1 (tan (dtor angsl)))
)
(setq
lb (/ trih (tan (dtor angsl))))
(if
(and(> (rtod ang) 0)(< (rtod ang) 90))
(progn
(setq pta2 (polar pta1 (dtor
180.0) lb))
(setq txtlr (list (+(car
pta1)txth)(+(cadr pta1)(/ trih 2.0))))
(setq txtblr (list (-(car pta1)(/
lb 2.0))(-(cadr pta1)(/ txth 2.0))))
)
(progn
(setq pta2 (polar pta1 (dtor 0)
lb))
(setq txtlr (list (-(car
pta1)txth)(+(cadr pta1)(/ trih 2.0))))
(setq txtblr (list (+(car pta1)(/
lb 2.0))(-(cadr pta1)(/ txth 2.0))))
)
)
(command
"_pline" mp pta1 pta2 "c")
(myText
"SLOPE-TEXT" "mc" txtlr txth 0 1 "1");angle 0
colour 1
(myText
"SLOPE-TEXT" "tc" txtblr txth 0 1 (rtos ratio 2 2));angle 0
colour 1
(myText
"SLOPE-TEXT" "bc" mp txth ang 1
(strcat "Ang " (rtos angsl 2 2)
"%%d"
" Slope " (rtos perc 2
2) "%"
" 1:"(rtos ratio 2 2)
)
)
(princ)
);end
tri
(defun
myText (txtStyle txtJust insertPt textHeight ang col txtString)
(if (= txtJust "L") (setq
horJust 0
verJust 0));Left
(if (= txtJust "C") (setq
horJust 1
verJust 0));Center
(if (= txtJust "R") (setq
horJust 2
verJust 0));Right
(if (= txtJust "bl") (setq
horJust 0
verJust 1));Bottom Left
(if (= txtJust "bc") (setq
horJust 1
verJust 1));Bottom Center
(if (= txtJust "br") (setq
horJust 2
verJust 1));Bottom Right
(if (= txtJust "ml") (setq
horJust 0
verJust 2));Middle Left
(if (= txtJust "mc") (setq
horJust 1
verJust 2));Middle Center
(if (= txtJust "mr") (setq
horJust 2
verJust 2));Middle Right
(if (= txtJust "tl") (setq
horJust 0
verJust 3));Top Left
(if (= txtJust "tc") (setq
horJust 1
verJust 3));Top Center
(if (= txtJust "tr") (setq
horJust 2
verJust 3));Top Right
;(myText
"AREA-TEXT" "mc" pt txth 0 col tarea)
;These
values are just being used for testing
;(setq txtStyle "Standard")
;(setq insertPt (list 2.0 3.0))
;(setq txtString "test")
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 7
txtStyle) ;Text style name
(cons 10 insertPt) ;First alignment point
(cons 11 insertPt) ;Second alignment point
(cons 40 textHeight)
(cons 1
txtString) ;Default value (the string itself)
(cons 50 ang) ;Text rotation
(cons 62 col) ;Text Colour
(cons 71 0) ;Flags 0=Normal, 2=Backward,
4=Upside down
(cons 72 horJust) ;Horizontal text
justification,0=Left,1=Center,2=Right,4=Center,5=Fit
(cons 73 verJust) ;Vertical text
justification, 0=Baseline,1=Bottom,2=Middle,3=Top
)
)
)
