Đến nội dung


Hình ảnh
- - - - -

Nhờ các bạn lisp overshoot và undershoot


  • Please log in to reply
15 replies to this topic

#1 cn_hang1

cn_hang1

    Chưa sử dụng CAD

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

Đã gửi 30 March 2009 - 09:36 PM

Mình có một bài như sau mong các bạn viết lisp giúp mình nhé:
+ layer 11 là rìa đường
+ layer 12 là line kích thước
Mình muốn lisp kiểm tra và tạo ra point style khi phát hiện ra lỗi undershoot (chưa tới) và overshoot (vượt quá) cụ thể là :
line layer 12 khi bắt snap vào hai bên đường (layer 11) nếu phát hiện chưa tới hoặc vượt quá thì nó sẽ báo lỗi bằng point style
file attach kèm theo : http://www.cadviet.com/upfiles/file.dxf
Rất cảm ơn nhiu nhìu nhé !
Hình đã gửi
  • 0

#2 cn_hang1

cn_hang1

    Chưa sử dụng CAD

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

Đã gửi 31 March 2009 - 06:28 PM

hổng ai viết giùm mình hả ...hu hu bu'n wá !!
  • 0

#3 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 31 March 2009 - 06:49 PM

hổng ai viết giùm mình hả ...hu hu bu'n wá !!

Mình cũng bùn quá vì không hiểu hết ý bạn hỏi, và mục đích cuối cùng là để làm gì. Bạn lại không up đúng file bản vẽ lên. Hu hu
  • 1

#4 cn_hang1

cn_hang1

    Chưa sử dụng CAD

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

Đã gửi 31 March 2009 - 10:33 PM

Mình cũng bùn quá vì không hiểu hết ý bạn hỏi, và mục đích cuối cùng là để làm gì. Bạn lại không up đúng file bản vẽ lên. Hu hu

Bản vẽ đó là đúng đó . bạn phải zoom to 2 điểm point của mình lên mới thấy rõ . Còn mục đích chính là để check lỗi đó bạn
giúp mình với .
  • 0

#5 maihoathao

maihoathao

    biết pan

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

Đã gửi 15 April 2009 - 04:40 PM

Mình cũng đang quan tâm đến vấn đề này, các bác cao thủ nào ra tay giúp tại hạ đi ạ!
  • 0

#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 15 April 2009 - 08:58 PM

Mình có một bài như sau mong các bạn viết lisp giúp mình nhé:
+ layer 11 là rìa đường
+ layer 12 là line kích thước
Mình muốn lisp kiểm tra và tạo ra point style khi phát hiện ra lỗi undershoot (chưa tới) và overshoot (vượt quá) cụ thể là :
line layer 12 khi bắt snap vào hai bên đường (layer 11) nếu phát hiện chưa tới hoặc vượt quá thì nó sẽ báo lỗi bằng point style
file attach kèm theo : http://www.cadviet.com/upfiles/file.dxf
Rất cảm ơn nhiu nhìu nhé !
Hình đã gửi

Vấn đề của bạn đã có bạn hỏi rồi và đã có câu trả lời ở đây và cũng có Lisp giải quyết ở đây :
http://www.cadviet.c...o...205&st=1800
Bạn đọc kỹ nhé. Có gì thắc mắc thì post lên đây, tốt nhất là bạn nên minh hoạ bằng hình ảnh hoặc file .dwg.
Mọi người sẽ giúp bạn.
Chào bạn
  • 0

#7 Flex

Flex

    biết lệnh erase

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

Đã gửi 15 April 2009 - 09:27 PM

Vấn đề của bạn đã có bạn hỏi rồi và đã có câu trả lời ở đây và cũng có Lisp giải quyết ở đây :
http://www.cadviet.c...o...205&st=1800
Bạn đọc kỹ nhé. Có gì thắc mắc thì post lên đây, tốt nhất là bạn nên minh hoạ bằng hình ảnh hoặc file .dwg.
Mọi người sẽ giúp bạn.
Chào bạn



Trong Land hoặc civil có tiện ích cleanup giải quyết mọi vấn đề về thừa thiếu một tí. Các bác chả chịu tìm hiểu gì, Lisp làm sao mà chơi đc bản vẽ địa chính số hoá có hàng nghìn trường hợp thừa thiếu một tí bao gồm cả Line/Polyline/Arc/ Circle/ còn chéo nhau nữa chứ (khác cao độ).
  • 0
Phần mềm và Tiện ích trên AutoCAD
->SHD- Phần mềm TK nhà xưởng thép tiền chế
->Nhận hợp tác thiết kế nhà thép tiền chế
website: www.cad-app.com
email: flexnet@cad-app.com
ym: flex_tools

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 16 April 2009 - 05:33 AM

Trong Land hoặc civil có tiện ích cleanup giải quyết mọi vấn đề về thừa thiếu một tí. Các bác chả chịu tìm hiểu gì, Lisp làm sao mà chơi đc bản vẽ địa chính số hoá có hàng nghìn trường hợp thừa thiếu một tí bao gồm cả Line/Polyline/Arc/ Circle/ còn chéo nhau nữa chứ (khác cao độ).

Lời nói chẳng mất tiền mua
Lựa lời mà nói cho vừa lòng nhau

  • 0

#9 maihoathao

maihoathao

    biết pan

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

Đã gửi 16 April 2009 - 10:40 AM

Bạn ơi mình chẳng tìm thấy nó ở đâu cả. nếu có thể bạn gửi qua hòm mail cho mình code lisp được không
email là : maihoathaoit@gmail.com
thanks bạn rất nhiều
  • 0

#10 q288

q288

    biết lệnh fillet

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

Đã gửi 16 April 2009 - 11:33 AM

Bạn ơi mình chẳng tìm thấy nó ở đâu cả. nếu có thể bạn gửi qua hòm mail cho mình code lisp được không
email là : maihoathaoit@gmail.com
thanks bạn rất nhiều


Chương trình này trước đây đã có bạn hỏi rồi và mình đã viết rồi, ban có thề coi lại ở
http://www.cadviet.c...o...205&st=1820
Tuy nhiên file của bạn khác với file trước ở tên layer nên mình có đổi chút ít cho phù hợp.


(defun c:chk (/ os ss v0 v L p1 p2 ss1 n)

;;;Intersections of e1, e2. Return LIST of points
;;;Thank Mr. Hoanh for this function!
(defun ints (e1 e2 / ob1 ob2 V L1 L2)
(setq ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2))
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendBoth)))
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
(setq L1 (vlax-safearray->list V)
L2 nil)
(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))) )
(setq L2 nil))
L2
)

;;; Bat diem
(defun batd(a1 a2 / ss0 s i)
(setq ss0 (ssget "c" (polar a1 (* -0.25 pi) 0.01)
(polar a1 (* 0.75 pi) 0.01))
i 0
s (ssadd))
(repeat (sslength ss0)
(setq s (ssadd (ssname ss0 i) s)
i (1+ i)))
(setq ss0 (ssget "c" (polar a2 (* -0.25 pi) 0.01)
(polar a2 (* 0.75 pi) 0.01))
i 0)
(repeat (sslength ss0)
(setq s (ssadd (ssname ss0 i) s)
i (1+ i)))
s
)

;;; Main function
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setvar "CLAYER" "12")
(setvar "CECOLOR" "1")
(setvar "PDMODE" 3)
(command "zoom" "e")
(setq ss (ssget "X" '((8 . "12")))
n 0)

(repeat (sslength ss)
(setq v0 (ssname ss n)
v (vlax-ename->vla-object v0)
L nil )

(if (= (cdr (assoc 0 (entget v0))) "LWPOLYLINE")
(progn
(setq p1 (vlax-curve-getStartPoint v)
p2 (vlax-curve-getEndPoint v)
ss1 (batd p1 p2))

(if (and (= (sslength ss1) 1) (ssmemb v0 ss1))
(progn
(command "Point" p1)
(command "Point" p2))
(progn
(setq ss1 (ssdel v0 ss1))
(while (> (sslength ss1) 0)
(setq L (append L (ints v0 (ssname ss1 0)))
ss1 (ssdel (ssname ss1 0) ss1)))
(if (not (member p1 L)) (command "Point" p1))
(if (not (member p2 L)) (command "Point" p2))))))
(setq n (1+ n))
)
(setvar "OSMODE" os)
)



  • 1

#11 maihoathao

maihoathao

    biết pan

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

Đã gửi 16 April 2009 - 01:29 PM

thanks bác, nhưng mà cái code này chạy không đúng ý em rùi, bác sửa lại hộ em nhé.em chỉ cần kiểm tra giữa 2 layer phát sinh lỗi thì mới đánh dấu vào , còn code lisp này thì nó đánh dấu toàn bộ à. sửa hộ em nhé,
file gốc đây ạ:

http://www.cadviet.c...check_loi_1.dwg
  • 0

#12 q288

q288

    biết lệnh fillet

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

Đã gửi 16 April 2009 - 02:36 PM

thanks bác, nhưng mà cái code này chạy không đúng ý em rùi, bác sửa lại hộ em nhé.em chỉ cần kiểm tra giữa 2 layer phát sinh lỗi thì mới đánh dấu vào , còn code lisp này thì nó đánh dấu toàn bộ à. sửa hộ em nhé,
file gốc đây ạ:

http://www.cadviet.c...check_loi_1.dwg

Bạn cần check 2 layer nào?
  • 0

#13 maihoathao

maihoathao

    biết pan

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

Đã gửi 16 April 2009 - 03:39 PM

Bạn cần check 2 layer nào?


layer 11 và 19 đấy ạ?
  • 0

#14 maihoathao

maihoathao

    biết pan

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

Đã gửi 17 April 2009 - 08:14 AM

Trong Land hoặc civil có tiện ích cleanup giải quyết mọi vấn đề về thừa thiếu một tí. Các bác chả chịu tìm hiểu gì, Lisp làm sao mà chơi đc bản vẽ địa chính số hoá có hàng nghìn trường hợp thừa thiếu một tí bao gồm cả Line/Polyline/Arc/ Circle/ còn chéo nhau nữa chứ (khác cao độ).


Nếu bác biết thì chỉ cho anh em đi, em không biết thì mới hỏi chứ không phải là không chịu tìm hiểu đâu bác ạ.
  • 0

#15 q288

q288

    biết lệnh fillet

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

Đã gửi 17 April 2009 - 12:48 PM

layer 11 và 19 đấy ạ?


Bạn thử dùng code sau đây xem sao. Ten lệnh chk.


(vl-load-com)

(defun c:chk (/ os ss v0 v L p1 p2 ss1 n cla)

;;;Intersections of e1, e2. Return LIST of points
;;;Thank Mr. Hoanh for this function!
(defun ints (e1 e2 / ob1 ob2 V L1 L2)
(setq ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2))
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendBoth)) )
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
(setq L1 (vlax-safearray->list V)
L2 nil)
(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))
)
)
(setq L2 nil)
)
L2
)

;;; Bat diem
(defun batd (a1 a2 v1 / ss v2)
(setq ss nil k 1)
(while (or (null ss) (= (sslength ss) 1))
(setq ss (ssget "f" (list (polar a2 (angle a1 a2) (* k 0.01))
(polar a1 (angle a2 a1) (* k 0.01))))
k (1+ k)) )

(if (ssmemb v1 ss) (ssdel v1 ss))
(setq v2 (vlax-ename->vla-object (ssname ss 0)))
(if (< (distance a1 (vlax-curve-getClosestPointTo v2 a1))
(distance a2 (vlax-curve-getClosestPointTo v2 a2)))
(list a1 (ssname ss 0))
(list a2 (ssname ss 0)))
)

;;; Main function

(setq os (getvar "OSMODE"))
(command "ucs" "w")
(setvar "OSMODE" 0)
(setvar "CECOLOR" "2")
(setvar "PDMODE" 34)
(setvar "CLAYER" "19")
(command "-layer" "off" "*" "y" "on" "19" "on" "11" "")
(command "zoom" "e")
(setq ss (ssget "X" (list (cons 8 "19")))
n 0)

(repeat (sslength ss)
(setq v0 (ssname ss n)
v (vlax-ename->vla-object v0)
L nil)

(if (= (cdr (assoc 0 (entget v0))) "LWPOLYLINE")
(progn
(setq p1 (vlax-curve-getStartPoint v)
p2 (vlax-curve-getEndPoint v))

(if (setq L1 (batd p1 p2 v0))
(progn
(setq v1 (last L1))
(if (not (equal (car L1) (car (ints v0 v1)) 0.00001)) (command "Point" (car L1)))))
)
)
(setq n (1+ n))
)
(setvar "OSMODE" os)
)


  • 0

#16 maihoathao

maihoathao

    biết pan

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

Đã gửi 20 April 2009 - 10:03 AM

Cảm ơn bạn rất nhiều, mình đã thử lại rồi, chạy ok .
  • 0