Chào cả nhà, cả nhà giúp em sửa lisp ca này hộ em với !

[phungan_utc 0]

Em có cái lisp này dể ghi cao độ vào kích thước so với 1 điểm gốc nhưng có 1 số điêm cần đo nó ko bắt điểm dc. Mọi người chỉnh giúp e với, con gà nên ko biết sửa. Em cảm ơn !

 

;Ghi cao do, offset cua diem can cu vao diem goc

(defun c:eff ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)

(setvar "osmode" 1)

(command "ucs" "w")

(setq pt (getpoint "\nPick reference point: ")

ent (entget(car(entsel "\nSelect elevation text: ")))

etype (cdr(assoc 0 ent))

txth (cdr(assoc 40 ent))

)

(if (/= etype "TEXT") (progn 

(princ "\nThe elevation selection must be a TEXT entity")

(exit))

(setq elev (atof(cdr(assoc 1 ent))))

)

 

(command "layer" "m" "UNSUITABLE" "")

 

(while (setq p1(getpoint "\nPick offset point"))

(setq elev1 (+ elev (- (cadr p1) (cadr pt)))

offset (abs(- (car p1) (car pt)))

p01 (polar p1 (* 3.0 (/ pi 2)) txth)

p01 (polar p01 pi (* 0.9 txth))

p02 (polar p01 0 (* 1.6 txth))

ecopy (list (assoc 0 ent)

(cons 100 "AcDbEntity")

(cons 8 "UNSUITABLE")

(cons 100 "AcDbText")

(assoc 10 ent)

(assoc 40 ent)

(cons 1 (strcat "" (rtos elev1 2 2)))

(assoc 50 ent)

(assoc 41 ent)

(assoc 51 ent)

(assoc 7 ent)

(cons 71 0)

(cons 72 2)

(list 11 (car p01) (cadr p01) 0.0)

(list 210 0.0 0.0 1.0)

(cons 100 "AcDbText")

(cons 73 2)

)

)

(entmake ecopy)

(setq ecopy (list (assoc 0 ent)

(cons 100 "AcDbEntity")

(cons 8 "UNSUITABLE")

(cons 100 "AcDbText")

(assoc 10 ent)

(assoc 40 ent)

(cons 1 (strcat "" (rtos offset 2 2)))

(assoc 50 ent)

(assoc 41 ent)

(assoc 51 ent)

(assoc 7 ent)

(cons 71 0)

(cons 72 2)

(list 11 (car p02) (cadr p02) 0.0)

(list 210 0.0 0.0 1.0)

(cons 100 "AcDbText")

(cons 73 2)

)

)

(entmake ecopy)

(princ "\nPress ESC or SPACE bar to cancel")

)

(end_task)

)