Đến nội dung


Hình ảnh
- - - - -

[Sửa lisp] Vẽ mặt cắt địa hình từ lisp tìm giao điểm


  • Please log in to reply
14 replies to this topic

#1 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 11:18 AM

Sau khi trao đổi và học hỏi với phamthanhbinh mình viết được lisp sau:

http://www.cadviet.c...khong_gian1.lsp

http://www.cadviet.c...3_new_block.dwg

Nhưng xảy ra lỗi. Mình đã thể hiện cụ thể trong bản vẽ

Rất mong nhận được sự giúp đỡ của các bạn.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 29 October 2013 - 03:42 PM

Hàm vlax-curve-getparamatpoint sẽ cho kết quả sai đối với LINE, vì vậy bạn dùng đường tìm giao điểm là pline hoặc dùng đoạn code sau thay cho

(setq plst (vl-sort plst .....

 

(setq pst (vlax-curve-getStartPoint e2))
(setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))

Code bạn viết dùng (car vtmc) (cadr vtmc) rất nhiều chỗ, nên đặt biến trung gian VD: xo, yo

(+ (carvtmc) -30)  => x1

(+ (car vtmc) -31)  => x2

Dùng hàm atoi thay vì atof đối với số nguyên

(rtos (setq moc0 (+ moc0 1)) 2 0) => (atoi (setq moc0 (1+ moc0)))


  • 1

#3 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 03:54 PM

Hàm vlax-curve-getparamatpoint sẽ cho kết quả sai đối với LINE, vì vậy bạn dùng đường tìm giao điểm là pline hoặc dùng đoạn code sau thay cho

(setq plst (vl-sort plst .....

 

(setq pst (vlax-curve-getStartPoint e2))
(setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))

Code bạn viết dùng (car vtmc) (cadr vtmc) rất nhiều chỗ, nên đặt biến trung gian VD: xo, yo

(+ (carvtmc) -30)  => x1

(+ (car vtmc) -31)  => x2

Dùng hàm atoi thay vì atof đối với số nguyên

(rtos (setq moc0 (+ moc0 1)) 2 0) => (atoi (setq moc0 (1+ moc0)))

Đang test phần sửa của bạn.

(rtos (setq moc0 (+ moc0 1)) 2 0) => (atoi (setq moc0 (1+ moc0))) là không được vì ở đây cần trả về giá trị STRING.

Còn vì sao mình không đặt điểm trung gian vì mình muốn quy định chỉ 1 điểm biết còn các điểm khác không biết.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 29 October 2013 - 04:05 PM

ITOA chứ không phải ATOI. Chắc do bạn ntdnv viết vội nên nhầm.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 04:10 PM

ITOA chứ không phải ATOI. Chắc do bạn ntdnv viết vội nên nhầm.

không phải nhầm đầu vì cầu tiếp theo của bạn ý là atof mờ... hì hì hì


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#6 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 04:13 PM

Quên mất các bạn giúp mình trong trường hợp các đường đồng mức trùng nhau thì plst phải xử lý thế nào để không có toạ độ trùng.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#7 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 03:04 PM

Hàm vlax-curve-getparamatpoint sẽ cho kết quả sai đối với LINE, vì vậy bạn dùng đường tìm giao điểm là pline hoặc dùng đoạn code sau thay cho

(setq plst (vl-sort plst .....

 

(setq pst (vlax-curve-getStartPoint e2))
(setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))

Code bạn viết dùng (car vtmc) (cadr vtmc) rất nhiều chỗ, nên đặt biến trung gian VD: xo, yo

(+ (carvtmc) -30)  => x1

(+ (car vtmc) -31)  => x2

Dùng hàm atoi thay vì atof đối với số nguyên

(rtos (setq moc0 (+ moc0 1)) 2 0) => (atoi (setq moc0 (1+ moc0)))

Trong trường hợp như hình vẽ thì hàm của bạn chưa đúng bạn có thể sửa giúp mình không, mình đã nghĩ ra 1 hàm nhưng kết quả vẫn sai.

http://www.cadviet.c...633_dongmuc.dwg

(setq plst (vl-sort plst '(lambda (x y) (< (vlax-curve-getDistAtPoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getDistAtPoint e2 (list (car y) (cadr y) 0))))))


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#8 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 31 October 2013 - 07:41 AM

Tách thành 2 trường hợp

(if (= (cdr (assoc 0 (entget e2))) "LINE")
        (progn
            (setq pst (vlax-curve-getStartPoint e2))
            (setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))
        )
        (setq plst (vl-sort plst '(lambda (x y)
            (< (vlax-curve-getparamatpoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getparamatpoint e2 (list (car y) (cadr y) 0)))))))

  • 0

#9 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 31 October 2013 - 08:29 AM

Tách thành 2 trường hợp

 

(if (= (cdr (assoc 0 (entget e2))) "LINE")
        (progn
            (setq pst (vlax-curve-getStartPoint e2))
            (setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))
        )
        (setq plst (vl-sort plst '(lambda (x y)
            (< (vlax-curve-getparamatpoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getparamatpoint e2 (list (car y) (cadr y) 0)))))))

mình cũng đã tách. Nhưng với bản vẽ #7 thì không cho kết quả đúng. Bạn có thể xem lại giúp mình không?

Mình thử bản vẽ mới thì tất cả ok. Nhưng với bản vẽ mình up lên ở #7 thì không đúng. Bạn có thể nói cho mình vì sao nó lại sai lệch không.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#10 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 31 October 2013 - 08:46 AM

mình cũng đã tách. Nhưng với bản vẽ #7 thì không cho kết quả đúng. Bạn có thể xem lại giúp mình không?

Mình test đúng trên bản vẽ đó. Nhưng mặt cắt không đúng với thực tế là cao trình đỉnh giữa của pline phải cao hơn (hoặc thấp hơn) cao trình đường đồng mức trong cùng. Bạn phải thêm bằng thủ công hoặc vẽ thêm 1 pline cao trình lẻ qua đỉnh đó


  • 0

#11 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 31 October 2013 - 09:34 AM

Mình test đúng trên bản vẽ đó. Nhưng mặt cắt không đúng với thực tế là cao trình đỉnh giữa của pline phải cao hơn (hoặc thấp hơn) cao trình đường đồng mức trong cùng. Bạn phải thêm bằng thủ công hoặc vẽ thêm 1 pline cao trình lẻ qua đỉnh đó

Vấn đề không nằm ở đó bạn à. mình post ở đây bạn xem nhé

http://www.cadviet.c...-tim-giao-diem/


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#12 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 01 November 2013 - 08:37 AM

Thêm hàm sau và sửa đoạn sort plst

(defun getparam2d (e p)
    (vlax-curve-getparamatpoint e (vlax-curve-getClosestPointTo e (list (car p) (cadr p) 0))))

(setq plst (vl-sort plst '(lambda (x y)
            (< (getparam2d e2 x) (getparam2d e2 y)))))
 

  • 1

#13 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 01 November 2013 - 09:06 AM

Cảm ơn bạn mình đã test nhưng ......... với ít đường đồng mức thì đúng, càng nhiều đường đồng mức thì lại sai một số điểm.

Bạn test lại hộ mình với bản vẽ này nhé.

http://www.cadviet.c...3_dongmuc_2.dwg


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#14 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 01 November 2013 - 10:14 AM

Do bản vẽ của bạn sử dụng 2DPolyline được tạo ra từ các phiên bản Cad đời cũ, nên k/quả đôi khi ko chính xác.

Cách khắc phục là dùng lệnh Convert hoặc PEdit để chuyển qua LWPolyline trước khi chạy Lisp.


  • 1

#15 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 01 November 2013 - 02:27 PM

Cảm ơn bạn nhiều mọi thứ đúng như vậy.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.