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

GHI CAO ĐỘ TUYẾN CỐNG

Bởi abc007 , trong AutoLisp

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

abc007    2

abc007
Đã đăng

Nhờ các Bác giúp 1 lisp có nội dung như sau:

1.Bản vẽ có 1 tuyến cống được thể hiện là 1 đường Pline ( Tại các điểm của Pline này sẽ được ghi cao độ ) cho 2 trường hợp sau :

- Trường hợp 1:

Chọn Pline ,Cho cao độ điểm đầu, Cho độ dốc (VD : 2%) .Chương trình tự động đặt node và ghi cao độ tại các điểm của Pline .

- Trường hợp 2:

Chọn Pline , Cho cao độ điểm đầu , cho cao độ điểm cuối .Chương trình tự động đặt node và ghi cao độ tại các điểm của Pline ( Độ dốc đều nhau).

Cả hai trường hợp đều ghi bắt đầu từ điểm đầu.

Thank các 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

hoa35ktxd    38

hoa35ktxd
Đã đăng

Bạn thử cái này xem nhé

(defun c:PLLEV(/ PL LenPL I Points LenPoint)
 (setq PL (entget (car (entsel "\nChon 1 Polyline: ")))
I 0
LenPL (length PL))
 (if (= (cdr (assoc 0 PL)) "LWPOLYLINE")
(progn
  (while (< I LenPL)
(if (= (nth 0 (nth I PL)) 10 )
  (setq Points (append Points (list (cdr (nth I PL))))
	LenPoints (length Points))
)
(setq I (1+ I))
  )
  (setq LV (getreal "\nNhap cao do dau: ")
	Id (Getreal "\nNhap do doc doc: ")
	I 0)
  (while (< I LenPoints)
(setq Point (nth I Points))
(If (= I 0)
  (progn
	(command "TEXT" "j" "MC" Point "" "" (rtos LV 2 3) "")
	(setq LPoint Point)
  )
  (progn
	(setq Len (distance Lpoint Point)
	  NewLV (+ LV (/ (* Id Len) 100.0)))
	(command "TEXT" "j" "MC" Point "" "" (rtos NewLV 2 3) "")
	(setq LPoint Point
	  LV NewLV)
  )
)
(setq I (1+ I))
  )
)
 )
)
(defun c:PL2LEV(/ PL LenPL I Points LenPoint)
 (setq PL (entget (car (entsel "\nChon 1 Polyline: ")))
I 0
LenPL (length PL))
 (if (= (cdr (assoc 0 PL)) "LWPOLYLINE")
(progn
  (while (< I LenPL)
(if (= (nth 0 (nth I PL)) 10 )
  (setq Points (append Points (list (cdr (nth I PL))))
	LenPoints (length Points))
)
(setq I (1+ I))
  )
  (setq SLV (getreal "\nNhap cao do dau: ")
	ELV (Getreal "\nNhap cao do cuoi: ")
	I 1
	Dist 0)
  (setq SPoint (nth 0 Points))
  (while (< I LenPoints)
(setq Point (nth I Points)
	  Dist (+ Dist (distance Point Spoint))
	  Spoint Point
	  I (1+ I))
  )
  (setq Id (/ (- ELV SLV) Dist)
	I 0)
  (while (< I LenPoints)
(setq Point (nth I Points))
(If (= I 0)
  (progn
	(command "TEXT" "j" "MC" Point "" "" (rtos SLV 2 3) "")
	(setq LPoint Point)
  )
  (progn
	(setq Len (distance Lpoint Point)
	  NewLV (+ SLV (* Id Len)))
	(command "TEXT" "j" "MC" Point "" "" (rtos NewLV 2 3) "")
	(setq LPoint Point
	  SLV NewLV)
  )
)
(setq I (1+ I))
  )
)
 )
)

  • Vote tăng 1

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

Tue_NV    3.912

Tue_NV
Đã đăng
Bạn thử cái này xem nhé

(defun c:PLLEV(/ PL LenPL I Points LenPoint)
 (setq PL (entget (car (entsel "\nChon 1 Polyline: ")))
I 0
LenPL (length PL))
 (if (= (cdr (assoc 0 PL)) "LWPOLYLINE")
(progn
  (while (	(if (= (nth 0 (nth I PL)) 10 )
  (setq Points (append Points (list (cdr (nth I PL))))
	LenPoints (length Points))
)
(setq I (1+ I))
  )
  (setq LV (getreal "\nNhap cao do dau: ")
	Id (Getreal "\nNhap do doc doc: ")
	I 0)
  (while (	(setq Point (nth I Points))
(If (= I 0)
  (progn
	(command "TEXT" "j" "MC" Point "" "" (rtos LV 2 3) "")
	(setq LPoint Point)
  )
  (progn
	(setq Len (distance Lpoint Point)
	  NewLV (+ LV (/ (* Id Len) 100.0)))
	(command "TEXT" "j" "MC" Point "" "" (rtos NewLV 2 3) "")
	(setq LPoint Point
	  LV NewLV)
  )
)
(setq I (1+ I))
  )
)
 )
)
(defun c:PL2LEV(/ PL LenPL I Points LenPoint)
 (setq PL (entget (car (entsel "\nChon 1 Polyline: ")))
I 0
LenPL (length PL))
 (if (= (cdr (assoc 0 PL)) "LWPOLYLINE")
(progn
  (while (	(if (= (nth 0 (nth I PL)) 10 )
  (setq Points (append Points (list (cdr (nth I PL))))
	LenPoints (length Points))
)
(setq I (1+ I))
  )
  (setq SLV (getreal "\nNhap cao do dau: ")
	ELV (Getreal "\nNhap cao do cuoi: ")
	I 1
	Dist 0)
  (setq SPoint (nth 0 Points))
  (while (	(setq Point (nth I Points)
	  Dist (+ Dist (distance Point Spoint))
	  Spoint Point
	  I (1+ I))
  )
  (setq Id (/ (- ELV SLV) Dist)
	I 0)
  (while (	(setq Point (nth I Points))
(If (= I 0)
  (progn
	(command "TEXT" "j" "MC" Point "" "" (rtos SLV 2 3) "")
	(setq LPoint Point)
  )
  (progn
	(setq Len (distance Lpoint Point)
	  NewLV (+ SLV (* Id Len)))
	(command "TEXT" "j" "MC" Point "" "" (rtos NewLV 2 3) "")
	(setq LPoint Point
	  SLV NewLV)
  )
)
(setq I (1+ I))
  )
)
 )
)

Chào bác hoa35ktxd

Lisp trên chỉ chạy đúng với các tuyến cống thẳng (thể hiện bằng phân đoạn Line (Line segment)

Và nó không còn đúng nữa đối với các tuyến cống cong (thể hiện bằng phân đoạn Arc (Arc segment)

Bởi lẽ bác thể hiện khoảng cách giữa 2 điểm bằng hàm distance thì với Line chính là chiều dài của nó còn với Arc là chiều dài dây cung (nối điểm đầu và điểm cuối arc)

 

1 ý nhỏ nữa là : Lisp chạy 1 mạch từ điểm đầu đến điểm cuối Pline, đôi lúc cũng không trúng ý User. Vì Úser muốn nó chạy theo chiều ngược lại

 

Cái nữa là bác có thể thay thế đoạn mã này :

      (while (

    (if (= (nth 0 (nth I PL)) 10 )

      (setq Points (append Points (list (cdr (nth I PL))))

        LenPoints (length Points))

    )

    (setq I (1+ I))

      )

bằng

(setq Points (mapcar 'cdr (vl-remove-if '(lambda(x) (if (/= (car x) 10) x)) pl)))

 (setq LenPoints (length Points))

 

Biến LenPoints nên đưa ra khỏi vòng lặp While đê tăng tốc độ xử lý List của Lisp

Vài dòng chia sẻ

  • Vote tăng 2

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

hoa35ktxd    38

hoa35ktxd
Đã đăng

Mấy điều bác nói tôi cũng đã trăn trở nhưng tặc lưỡi cho qua:

1. Ống cong: Vì đây là đường thoát nên tôi nghĩ chủ yếu là đoạn thẳng (Tôi chưa thi công cái nào cong)

2. Điểm đầu điểm cuối: Tôi cũng định thêm thủ tục chọn điểm đầu điểm cuối nhưng xét thấy cả 2 trường hợp đều không cần. Với trường hợp 1, nếu thấy không ưng ý thì chỉ cần đổi dấu của độ dốc dọc, trường hợp 2 thì đổi thứ tự nhập cao độ.

3. Lăn tăn mãi không tìm ra giải pháp nào nên quyết định dùng While, giờ được học hỏi thêm 1 chiêu quả thật bổ ích.

Vậy nên tôi cứ mạo muội tung lên đây, học hỏi dần thôi mà.

Cảm ơn bác nhiề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

Tue_NV    3.912

Tue_NV
Đã đăng
Mấy điều bác nói tôi cũng đã trăn trở nhưng tặc lưỡi cho qua:

1. Ống cong: Vì đây là đường thoát nên tôi nghĩ chủ yếu là đoạn thẳng (Tôi chưa thi công cái nào cong)

2. Điểm đầu điểm cuối: Tôi cũng định thêm thủ tục chọn điểm đầu điểm cuối nhưng xét thấy cả 2 trường hợp đều không cần. Với trường hợp 1, nếu thấy không ưng ý thì chỉ cần đổi dấu của độ dốc dọc, trường hợp 2 thì đổi thứ tự nhập cao độ.

3. Lăn tăn mãi không tìm ra giải pháp nào nên quyết định dùng While, giờ được học hỏi thêm 1 chiêu quả thật bổ ích.

Vậy nên tôi cứ mạo muội tung lên đây, học hỏi dần thôi mà.

Cảm ơn bác nhiều.

1. Đúng là ống cống chủ yếu là đoạn thẳng. Nhưng vẫn có những đoạn bo cong ở các ngã 3, ngã 4 của con đường. Bác Hoa đã từng đi thi công rồi à?

 

-> Kiến nghị : Thay thế hàm distance bằng hàm

(vlax-curve-getdistatpoint curve point)

Trong đó : Point là 1 tọa độ điểm

- Curve : là 1 ENAME hoặc là 1 VLA-OBJECT

 

-> Return : Khoảng cách tính từ điểm đầu curve cho đến điểm đang xét

 

Vậy thì để tính khoảng cách của 1 phân đoạn segment (LINE segment hoặc ARC segment) : điểm đầu là p1, điểm cuối là p2 thì sử dụng như sau :

(ABS (- (Vlax-curve-getdistatpoint curve p1) (Vlax-curve-getdistatpoint curve p2)))

 

2. Nếu User không ưng ý thì trước khi đổi dấu dộ dốc dọc (Tue_NV biết điều đó) thì bác phải xóa cái kết quả không ưng ý trước đó. Mất thêm 1 công đoạn nữa. Sao bác không vừa chọn được điểm đầu, vừa chọn Polyline cùng 1 lúc. Nếu User chọn không đúng điểm đầu thì yêu cầu chọn lại, không muốn làm nữa thì enter và thoát. Đằng nào bác cũng chọn Polyline, sao bác không sử dụng giải pháp trên

  • Vote tăng 2

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

hoa35ktxd    38

hoa35ktxd
Đã đăng

- Hoc xây dựng nên từ xếp gạch, trộn vữa... nôm na là công đoạn nào cũng được nếm rồi. Bây h thì hầu như chẳng làm gì liên quan đến XD nữa, nhớ nghề nêm mới lang thang các diễn đàn góp vui thôi.

- Quả thật mấy cái hàm đầu V lợi hại thật, tôi chưa có nhiều thời gian nghiên cứu hết được (coi chúng là đồ xa xỉ) chỉ biết dùng mấy cái hàm đơn giản thôi.

- Cách chọn điểm đầu và chon PL cùng 1 lúc là một ý quá hay. Càng đi nhiều càng mở mang tầm nhìn.

Cảm ơn 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

Tue_NV    3.912

Tue_NV
Đã đăng
- Hoc xây dựng nên từ xếp gạch, trộn vữa... nôm na là công đoạn nào cũng được nếm rồi. Bây h thì hầu như chẳng làm gì liên quan đến XD nữa, nhớ nghề nêm mới lang thang các diễn đàn góp vui thôi.

- Quả thật mấy cái hàm đầu V lợi hại thật, tôi chưa có nhiều thời gian nghiên cứu hết được (coi chúng là đồ xa xỉ) chỉ biết dùng mấy cái hàm đơn giản thôi.

- Cách chọn điểm đầu và chon PL cùng 1 lúc là một ý quá hay. Càng đi nhiều càng mở mang tầm nhìn.

Cảm ơn bác.

Bạn abc007 và hoa35ktxd thử code này nhé :

 

(defun c:PLLEV(/ OK PL LenPL I Points LenPoint ep NewLv Lv)
 (while (and (null OK)
      (setq ddau (getpoint "\n Chon diem dau cua tuyen Cong POLYLINE :")))
 (if (null ddau) (setq OK t)
   (if (and (setq PL (nentselp ddau))
     (wcmatch (cdr (assoc 0 (entget(car PL)))) "*POLYLINE")
     (or(equal (vlax-curve-getstartpoint (car PL)) ddau)
        (equal (vlax-curve-getEndpoint (car PL)) ddau)
     )
)
     (PROGN
(setq OK t)
(setq Points (mapcar 'cdr (vl-remove-if '(lambda(x) (if (/= (car x) 10) x))
	     (entget(car pl)))))
  	(if (equal (setq ep (vlax-curve-getEndpoint (car PL))) ddau)
   		 (setq Points (reverse Points))
       )
(setq LenPoints (length Points) i 1)
 	(setq lv (getreal "\nNhap cao do dau: ")
      Id (Getreal "\nNhap do doc doc: ")
)
 	(setq cao (getdist "\n NHap chieu cao Text :"))
(wtxt (rtos LV 2 3) ddau cao)
   (while (      (setq p1 (nth i Points))
     (if (equal ep ddau)
(setq Len (ABS (- (Vlax-curve-getdistatpoint (car PL) ep)
	           (Vlax-curve-getdistatpoint (car PL) p1)
	       )
	  )
)
       (setq Len (Vlax-curve-getdistatpoint (car PL) p1))
     )
       (setq NewLV (+ LV (/ (* Id Len) 100.0)))
       (wtxt (rtos NewLV 2 3) p1 cao)
     (setq i (1+ i))
   )

     );PROGN
       (princ "\n Chon diem dau khong dung tren POLYline")
   )
  )
 )
)
;;;
(defun wtxt(txt p cao)
 (entmake (list (cons 0 "TEXT")
	 (cons 10 p)
	 (cons 11 p)
	 (cons 1 txt)
	 (cons 40 cao)
	 (cons 72 1)
	 (cons 73 2)))
)

@Hoa35ktxd : Đây là code mà Tue_NV viết theo các ý trên :

Kiểm tra Chọn điểm đầu hoặc điểm cuối của Polyline, đồng thời chọn luôn Pline làm cơ sở tính toán

Nếu User chọn không đúng điểm đầu hoặc điểm cuối trên PLINE hoặc chọn trật thì Lisp sẽ báo câu :

Chon diem dau khong dung tren POLYline

Nếu không thích tính toán viết Text, bác cứ Enter -> kết thúc lệnh

 

Vì Pline trên màn hình CAD : User không nhận ra đâu là điểm đầu, đâu là điểm cuối nên :

- Nếu User chọn đúng điểm đầu thì Lisp sẽ tính toán và viết Text từ điểm đầu đến điểm cuối

- Nếu User chọn đúng điểm cuối thì Lisp sẽ tính toán và viết Text từ điểm cuối đến điểm đầu

 

Lisp đúng trong trường hợp ống cống có đoạn bo cong

Bác thử nhé :D

 

Rất vui nếu được biết tên bác và làm quen với bác :D

  • Like 1
  • Vote tăng 1

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

abc007    2

abc007
Đã đăng
Bạn abc007 và hoa35ktxd thử code này nhé :

 

(defun c:PLLEV(/ OK PL LenPL I Points LenPoint ep NewLv Lv)
 (while (and (null OK)
      (setq ddau (getpoint "\n Chon diem dau cua tuyen Cong POLYLINE :")))
 (if (null ddau) (setq OK t)
   (if (and (setq PL (nentselp ddau))
     (wcmatch (cdr (assoc 0 (entget(car PL)))) "*POLYLINE")
     (or(equal (vlax-curve-getstartpoint (car PL)) ddau)
        (equal (vlax-curve-getEndpoint (car PL)) ddau)
     )
)
     (PROGN
(setq OK t)
(setq Points (mapcar 'cdr (vl-remove-if '(lambda(x) (if (/= (car x) 10) x))
	     (entget(car pl)))))
  	(if (equal (setq ep (vlax-curve-getEndpoint (car PL))) ddau)
   		 (setq Points (reverse Points))
       )
(setq LenPoints (length Points) i 1)
 	(setq lv (getreal "\nNhap cao do dau: ")
      Id (Getreal "\nNhap do doc doc: ")
)
 	(setq cao (getdist "\n NHap chieu cao Text :"))
(wtxt (rtos LV 2 3) ddau cao)
   (while (< i LenPoints)
     (setq p1 (nth i Points))
     (if (equal ep ddau)
(setq Len (ABS (- (Vlax-curve-getdistatpoint (car PL) ep)
	           (Vlax-curve-getdistatpoint (car PL) p1)
	       )
	  )
)
       (setq Len (Vlax-curve-getdistatpoint (car PL) p1))
     )
       (setq NewLV (+ LV (/ (* Id Len) 100.0)))
       (wtxt (rtos NewLV 2 3) p1 cao)
     (setq i (1+ i))
   )

     );PROGN
       (princ "\n Chon diem dau khong dung tren POLYline")
   )
  )
 )
)
;;;
(defun wtxt(txt p cao)
 (entmake (list (cons 0 "TEXT")
	 (cons 10 p)
	 (cons 11 p)
	 (cons 1 txt)
	 (cons 40 cao)
	 (cons 72 1)
	 (cons 73 2)))
)

@Hoa35ktxd : Đây là code mà Tue_NV viết theo các ý trên :

Kiểm tra Chọn điểm đầu hoặc điểm cuối của Polyline, đồng thời chọn luôn Pline làm cơ sở tính toán

Nếu User chọn không đúng điểm đầu hoặc điểm cuối trên PLINE hoặc chọn trật thì Lisp sẽ báo câu :

Chon diem dau khong dung tren POLYline

Nếu không thích tính toán viết Text, bác cứ Enter -> kết thúc lệnh

 

Vì Pline trên màn hình CAD : User không nhận ra đâu là điểm đầu, đâu là điểm cuối nên :

- Nếu User chọn đúng điểm đầu thì Lisp sẽ tính toán và viết Text từ điểm đầu đến điểm cuối

- Nếu User chọn đúng điểm cuối thì Lisp sẽ tính toán và viết Text từ điểm cuối đến điểm đầu

 

Lisp đúng trong trường hợp ống cống có đoạn bo cong

Bác thử nhé :D

 

Rất vui nếu được biết tên bác và làm quen với bác :D

Thank hai Bác hoa35ktxd và Tue NV nhiều lắm , mình đang cần cái này, 2 Bác rất tuyệt.Thank

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
Về Đầu Trang AutoLisp
×