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

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

Bởi cn_hang1 , trong AutoLisp

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

cn_hang1    0

cn_hang1
Đã đăng

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é !

12_5.jpg

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

nataca    554

nataca
Đã đăng
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

  • 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

cn_hang1    0

cn_hang1
Đã đăng
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 .

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ì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é !

12_5.jpg

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.com/forum/index.php?sho...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

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

Flex    22

Flex
Đã đăng
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.com/forum/index.php?sho...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 độ).

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

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

maihoathao    0

maihoathao
Đã đăng

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

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

q288    166

q288
Đã đăng
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.com/forum/index.php?sho...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)
)

  • 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

maihoathao    0

maihoathao
Đã đăng

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.com/upfiles/check_loi_1.dwg

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

q288    166

q288
Đã đăng
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.com/upfiles/check_loi_1.dwg

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

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

maihoathao    0

maihoathao
Đã đăng
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 ạ.

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

q288    166

q288
Đã đăng
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)  
)

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
×