Chuyển đến nội dung
Diễn đàn CADViet
dauquangminh

[Yêu cầu] Lisp tính lý trình các điểm trên 1 polyline/line

Các bài được khuyến nghị

Hề hề hề

Phải chăng bạn cần cái này:



Hề hề hề.

@ phamxuanly gtvt: hãy gửi bản vẽ bị lỗi lên...

@ Bác Bình: Tôi cũng đã một số lisp lý trình, nhưng có cách nào để pick vào 1 điểm ngoài đường Pline tim mà nó vẫn nhận ra lý trình được không bác.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cảm ơn phamthanhbinh nhiều nhé. Em dùng thấy nó thật là ngon.

Bác cho e mượn cái code xào nấu thêm chút đỉnh cho theo ý nha.

Thank bác. nhiều nhé. Em dùng thấy ngon lắmnhêều

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

líp bi lỗi rồi bác bình ơi, mình thử dùng mà không được, nhờ bác xem hộ!

Hề hề hề,

Bác ơi em ốm, bác cứu em với !!!!!

Nhưng mà cứu thế nào khi chả biết em bị bệnh gì, sốt bao nhiêu độ, ăn được cái gì, uống được cái chi, gãy tay hay què cẳng ????

vậy nên nếu em muốn bác coi lại thì em phải nói cái lỗi nó như thế nào. CAD trả về cái gì khi chạy thì mới nói chuyện xem chứ. Bởi vì cái đó chủ thớt đã dùng và một vài người nữa cũng đả test chứ không phải mình quăng ẩu lên đâu.

Ấy là chưa kể em có hiểu mục đích sử dụng của lisp hay không vì: phúc thống mà phục nhân sâm thì tắc tử đó em ơi.

Hề hề hề.....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Hề hề hề

Phải chăng bạn cần cái này:


(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 (getstring t "\n Chon chieu ghi ly trinh <T or P>: "))
(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 (getint "\n Chon so chu so thap phan: "))
(setq l (getint "\n Chon phuong an ghi ly trinh <1 or 2>: "))
(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)
)



Hề hề hề.

@ phamxuanly gtvt: hãy gửi bản vẽ bị lỗi lên...

 

 

 

Kính chuyển bác phamthanhbinh lisp của bác khi chọn lý trình gốc là 0 thì tại 1000m ghi là Km1+000, 2000m ghi là Km2+000, 3000m ghi là Km3+000 thì ok, nhưng đến 4000m nó lại ghi là Km3+1000 bác xem lại nhé

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×