Nhờ các bác chỉnh sửa giúp em lisp ghi lý trình tuyến.

Tháng 8 11, 2021

Hiện tại e có tìm được 2 cái lisp trong cadviet ghi lý trình và ghi khoảnh cách tới tim và khoảng cách, nhưng giờ e muốn kết hợp cả 2 cái vào với nhau nhưng chưa biết chỉnh sửa thế nào cho đc, e thì cũng mới tìm hiểu về lisp lên chưa sửa được. Mong muốn của e thì đc như hình vẽ phí dưới. e muốn các bác chỉnh sửa lại cho e cái lisp: glt với ạ. xem xin cảm ơn các bác. em có để 2 lisp trong đính kèm file (KC và LT, e lấy trong lisp ttt để e chạy ra ạ). Em xin chân thành cảm ơn các bác nhiều.

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/53192-y%C3%AAu-c%E1%BA%A7u-lisp-t%C3%ADnh-l%C3%BD-tr%C3%ACnh-c%C3%A1c-%C4%91i%E1%BB%83m-tr%C3%AAn-1-polylineline/#entry168075

(defun c:glt (/ pl plst pa pd k l ltg p0 a lt lt1 lt2 txt tg etg txtp txtp1 txtp2 dl dl1 dl2)
(vl-load-com)
(command "undo" "be")
(setq ucsold (getvar "ucsname"))
(command "ucs" "w")
(setq pl (car (entsel "\n Chon polyline can ghi ly trinh")))
(setq plst (vl-sort (acet-geom-vertex-list pl) '(lambda (x y) (< (car x) (car y)))))
(setq pa "T")
(if (= (strcase pa) "T")
   (setq pd (car plst))
   (setq pd (last plst))
)
(setq p0 (getpoint "\n Chon diem goc ghi ly trinh"))
(setq ltg (getreal "\n Nhap ly trinh goc: "))         
(setq k 2)
(setq l 1)
(setq a (getpoint "\n Chon point can ghi ly trinh"))
(while ( /= a nil)
(if (= l 1)
   (progn
         (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001)
             (setq lt (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) 
                                  (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg )  )
             (setq lt (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) 
                                  (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))
                                    ) ltg )  )
         )
         (setq dl (abs (- lt (* (fix (/ lt 1000)) 1000))))
         (if (< (fix dl) 100)
             (if (< (fix dl) 10)
                 (setq txtp (strcat "00" (rtos dl 2 k)))
                 (setq txtp (strcat "0" (rtos dl 2 k)))
             )
             (setq txtp (rtos dl 2 k))
         )
         (if (> lt 0)
             (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "+" txtp))
             (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "-" txtp))
         ) 
         (setq tg (car (entsel "\n Chon text can thay the ")))
         (setq etg (entget tg))
         (setq etg (subst (cons 1 txt) (assoc 1 etg) etg))
         (entmod etg)
   )
   (progn
        (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001)
            (progn
                 (setq lt1 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))
                                        (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg )  )
                 (setq lt2 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh")))
                                        (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg ))
            )
            (progn
                (setq lt1 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) 
                                       (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))  ) ltg ))
                (setq lt2 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))
                                       (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh"))) ) ltg ))
            )
         )
         (setq dl1 (abs (- lt1 (* (fix (/ lt1 1000)) 1000))))
         (if (< (fix dl1) 100)
             (if (< (fix dl1) 10)
                 (setq txtp1 (strcat "00" (rtos dl1 2 k)))
                 (setq txtp1 (strcat "0" (rtos dl1 2 k)))
             )
             (setq txtp1 (rtos dl1 2 k))
         )
         (setq dl2 (abs (- lt2 (* (fix (/ lt2 1000)) 1000))))
         (if (< (fix dl2) 100)
             (if (< (fix dl2) 10)
                 (setq txtp2 (strcat "00" (rtos dl2 2 k)))
                 (setq txtp2 (strcat "0" (rtos dl2 2 k)))
             )
             (setq txtp2 (rtos dl2 2 k))
         )
         (if (and (>=  lt1 0) (>=  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 )))
         (if (and (>=  lt1 0) (<  lt2 0))
             (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 )))
         (if (and (<  lt1 0) (>=  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 ))) 
         (if (and (<  lt1 0) (<  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 )))
         (setq tg (car (entsel "\n Chon text can thay the ")))
         (setq etg (entget tg))
         (setq etg (subst (cons 1 txt) (assoc 1 etg) etg))
         (entmod etg)
    )
)
(setq a (getpoint "\n Ban hay chon diem tiep theo: "))
)
(if (/= ucsold "")
   (command "ucs" "p")
)
(command "undo" "e")
(princ)
)