Lisp tính cao độ từ 1 điểm đã biết

;;;-----Free lisp code from CADViet.com - Edited by Mathan - From VECC
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "Text chen them vao phia truoc: an 1[+ enter] de nhan text( " cheno " ) hoac nhap text: ")))
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok [enter] or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq tp (getint "\nNhap vao so chu so thap phan: "))
(setq phuongan (getint "\nNhap vao goc phuong an chen vao text co san (1) hoac tao text moi (2): "))
(if (= phuongan 2)
 (progn
(setq caochu (getreal "\nNhap vao chieu cao chu: "))
(setq goctext (getreal "\nNhap vao goc ra chu: "))
)
)
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq i 1 n 1000)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) ))) )
(if (= phuongan 1) (WriteRes1 cddc) )
(if (= phuongan 2) (command "TEXT" dchon caochu goctext (rtos cddc 2 tp)))
(setq i (+ i 1))
)
(princ)
)

Nguồn bài viết : https://www.cadviet.com/forum/topic/64401-y%C3%AAu-c%E1%BA%A7u-xin-lisp-ghi-cao-%C4%91%E1%BB%99/

Ngoài ra cần đọc ở đây :https://tamnangduongsinh.forumvi.com/t462-topic