Đến nội dung


Hình ảnh
- - - - -

GHI CAO ĐỘ TUYẾN CỐNG


  • Please log in to reply
7 replies to this topic

#1 abc007

abc007

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 21 August 2010 - 08:01 PM

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.
  • 0

#2 hoa35ktxd

hoa35ktxd

    biết lệnh move

  • Members
  • PipPipPip
  • 125 Bài viết
Điểm đánh giá: 38 (tàm tạm)

Đã gửi 22 August 2010 - 09:45 AM

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))
)
)
)
)

  • 1

#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 22 August 2010 - 03:29 PM

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))
)
)
)
)

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 (< 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))
      )

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ẻ
  • 2

#4 hoa35ktxd

hoa35ktxd

    biết lệnh move

  • Members
  • PipPipPip
  • 125 Bài viết
Điểm đánh giá: 38 (tàm tạm)

Đã gửi 22 August 2010 - 03:50 PM

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.
  • 0

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 22 August 2010 - 07:41 PM

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
  • 2

#6 hoa35ktxd

hoa35ktxd

    biết lệnh move

  • Members
  • PipPipPip
  • 125 Bài viết
Điểm đánh giá: 38 (tàm tạm)

Đã gửi 22 August 2010 - 08:16 PM

- 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.
  • 0

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 22 August 2010 - 09:55 PM

- 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 (< 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
  • 1

#8 abc007

abc007

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 23 August 2010 - 09:33 PM

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
  • 0