Elevation Marker

;|

Elevation Marker

- Pick Point to elevation 0.0

- Pick Direction line

- Pick Point to Mark elevation <enter to exit>

- Create and Design by Songkhran Jongkul August 2025

- Contact https://www.facebook.com/groups/AutolispTH

|;

(defun c:EMK ( / *error* txth dec lst trih ocs pt1 pt1a pt2 pt3 pt3a pt4 elv )

(defun *error* ( msg )

(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))

(princ (strcat "\nError: " msg))

)

(princ)

)

(setq txtStyle (getvar 'TEXTSTYLE)

txth (getvar 'TEXTSIZE)

dec 2

)

(setq old_osnap (getvar "osmode"))

(setq pelv0 (getpoint "\nPick Point to elevation 0.0 : "))

(setvar "orthomode" 1)

(setq ptdir (getpoint pelv0 "\nPick Direction line : "))

(setvar "orthomode" 0)

(setvar "osmode" 1)

(while (setq pt1 (getpoint "\nPick Point to Mark elevation <exit>: "))

(setq lst (* 1.45 txth)

trih(* lst (cos 0.523599))

pt1a (polar pt1 1.5708 trih)

ocs (trans '(0.0 0.0 1.0) 1 0 t)

)

;;---------Check Directions-------------------------+

(if(= (angle pelv0 ptdir) 0)

(setq pt2 (polar pt1a 3.14159 (/ lst 2.0))

pt3 (list (+(car pt2)(* lst 4.0))(cadr pt2))

pt3a (list (+(car pt2)lst)(cadr pt2))

pt4 (list (+(car pt2)(* lst 2.5))(cadr pt2))

)

(setq pt2 (polar pt1a 0 (/ lst 2.0))

pt3 (list (-(car pt2)(* lst 4.0))(cadr pt2))

pt3a (list (-(car pt2)lst)(cadr pt2))

pt4 (list (-(car pt2)(* lst 2.5))(cadr pt2))

)

)

(setq elv (- (cadr pt1)(cadr pelv0)))

(cond

(( = elv 0.000)(setq elv (strcat "%%P " (rtos elv 2 dec))))

((> elv 0.000)(setq elv (strcat "+ " (rtos elv 2 dec))))

((< elv 0.000)(setq elv (rtos elv 2 dec)))

)

(entmake

(list

'(000 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

'(090 . 3)

'(070 . 0)

(cons 038 (caddr pt1))

(cons 010 pt1)

'(040 . 0.0)

(cons 041 trih)

(cons 010 pt1a)

(cons 040 (* trih 0.05))

(cons 041 (* trih 0.05))

(cons 010 pt3)

(cons 210 ocs)

)

)

(entmake

(list

(cons 0 "TEXT")

(cons 100 "AcDbEntity")

(cons 100 "AcDbText")

(cons 7 txtStyle)

(cons 10 pt4)

(cons 11 pt4)

(cons 40 txth)

(cons 1 elv)

(cons 50 0)

(cons 71 0)

(cons 72 1)

(cons 73 1)

)

)

) ;;while

(setvar "osmode" old_osnap)

(princ)

)

(prompt "\n\t\t\t +------------------------------------------+\n")

(prompt "\n\t\t\t | Start with EMK to Elevation Marker |\n")

(prompt "\n\t\t\t +------------------------------------------+\n")

Slope Calculations 2

 

Slope Calculations 2

ตัวนี้เป็นแบบเลือกเส้นเอาเลย ทั้ง line หรือ Polyline โดยการหาตำแหน่ง start และ end ของเส้น

(defun c:slope2 (/ pt1 pt2 ptL ptT ang slp slple)

(vl-load-com)

(setq old_cmdecho (getvar "cmdecho")) ; cmdecho

(setvar "cmdecho" 0) ;;echo off

(if(and

(setq sel (entsel "\nSelect Slope line: "))

(setq ename (car sel))

(setq elist (entget ename))

)

(cond

((eq (cdr (assoc '0 elist)) "LINE")

(setq pt1 (cdr (assoc '10 elist))

pt2 (cdr (assoc '11 elist))

)

)

((eq (cdr (assoc '0 elist)) "LWPOLYLINE")

(setq pt_lst(mapcar 'cdr (vl-remove-if-not '(lambda (x) ( = (car x) 10)) elist))

pt1 (car pt_lst)

pt2 (last pt_lst)

)

)

); progn

); if

;;--------Test points Low or Height-----------------+

(if(and(>(car pt1)(car pt2))(>(cadr pt1)(cadr pt2)))

(setq ptL pt2

ptT pt1

)

(setq ptL pt1

ptT pt2

)

)

(setq ris (-(cadr ptT)(cadr ptL))) ;;Rise Vertical

(setq run (-(car ptT)(car ptL))) ;;Run Horizontal

(setq ang (/ (* (atan (/ ris run)) 180) pi)) ;;Angle of Degree

(setq angra (* ang (/ pi 180))) ;;Angle of Radial

(setq slp (*(/ ris run) 100.0)) ;;Slope %

(setq slple (/ ris (sin angra))) ;;Slope Length

(alert

(strcat "\nSlope = "(rtos slp 2 0) "%"

"\nSlope Length = "(rtos slple 2 3) "m."

"\nAngle = "(rtos ang 2 3) "\U+00B0"

)

)

(setvar "cmdecho" old_cmdecho)

(princ)

)