Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
toidihoc

Nhờ mọi người viết hộ em cái Lisp di chuyển hàng loạt đối tượng.

Bởi toidihoc , trong AutoLisp

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

toidihoc    0

toidihoc
Đã đăng

Em có một đoạn PL hình sin rất dài loằng ngoằng , Hai phía của đường PL có rất nhiều đoạn thẳng A,B,C... nằm lộn xộn, em muốn di chuyển tất cả các đường thẳng A,B,C... đó theo chiều F8 (vuông góc), sao cho điểm gần nhất của đoạn thẳng A,B,C... bắt vào đoạn PL.

Em gửi kèm theo file cad ạ:

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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
15 giờ trước, toidihoc đã nói:

Em có một đoạn PL hình sin rất dài loằng ngoằng , Hai phía của đường PL có rất nhiều đoạn thẳng A,B,C... nằm lộn xộn, em muốn di chuyển tất cả các đường thẳng A,B,C... đó theo chiều F8 (vuông góc), sao cho điểm gần nhất của đoạn thẳng A,B,C... bắt vào đoạn PL.

Em gửi kèm theo file cad ạ:

Drawing1.dwg

Mới test cho Line và PLine, còn ARC vs Circle chắc chờ các cao nhân

ezgif.com-video-to-gif (4).gif

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

quocmanh04tt    635

quocmanh04tt
Đã đăng
4 phút trước, Doan Van Ha đã nói:

Chưa có lisp để dòm nhưng đang nghi ngờ sẽ có ARC dính đạn.

Không biết dính hay không bác à! Lisp xét hai đầu của nó, từ 2 điểm gióng thẳng (// trục y) vào Pline zic zac, tiếp theo xét distance tương ứng 2 đầu của Arc với 2 điểm chiếu.  Từ đó lấy distance nhỏ làm khoảng cách move đối tượng.

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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
24 phút trước, quocmanh04tt đã nói:

Không biết dính hay không bác à! Lisp xét hai đầu của nó, từ 2 điểm gióng thẳng (// trục y) vào Pline zic zac, tiếp theo xét distance tương ứng 2 đầu của Arc với 2 điểm chiếu.  Từ đó lấy distance nhỏ làm khoảng cách move đối tượng.

E nghĩ bác Hạ nói dính ở đây chắc là dính tại điểm tiếp tuyến của ARC với PLINE

Untitled.png.933824d3f87353fc121d584760eaddd9.png

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

quocmanh04tt    635

quocmanh04tt
Đã đăng
4 phút trước, Doan Nguyen Van đã nói:

E nghĩ bác Hạ nói dính ở đây chắc là dính tại điểm tiếp tuyến của ARC với PLINE

Uh, chắc là vậy. Vì cái này trong đề bài không có (nếu có thì phải có điều kiện cụ thể). Bởi vậy mới nói không biết có dính hay không.

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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
5 phút trước, quocmanh04tt đã nói:

Uh, chắc là vậy. Vì cái này trong đề bài không có (nếu có thì phải có điều kiện cụ thể). Bởi vậy mới nói không biết có dính hay không.

Bởi thế nên mới cần tác giả lên để diễn giải, mà bạn này hỏi xong lại lặn mất tăm rồ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

toidihoc    0

toidihoc
Đã đăng

Thanks các bác nhiều. Bác cho em xin trước Lips này với ạ, em dùng tay đối với Cycle cũng là tuyệt lắm rồi.

Chân thành cám ơn mọi ngườ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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng 
(defun c:mm (/ getlst ss n ent osm lst2 lst ent1 pt1 pt2 tt p1 i x y)
  (defun getlst (p1 ent / p2 dis)
      (setq p2 (vlax-curve-getClosestPointToProjection ent p1 (list 0 1 0) ))
      (setq dis (distance p1 p2))
      (list dis p1 p2)	)
  (if(setq ss (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE,LINE,CIRCLE,ARC"))))) (progn (setq n 0)
(mapcar '(lambda (x) (if (= (cdr (assoc 0 (entget x))) "LWPOLYLINE") (if (> (vlax-curve-getendparam x) n) (progn(setq ent x) (setq n (vlax-curve-getendparam x)))))) ss)
  (setq lst2 (list))
  (Mapcar '(lambda (ent1)
    (setq lst (list))
    (if (= (cdr (assoc 0 (entget ent1))) "LINE") (progn
	(setq pt1 (vlax-curve-getpointatparam ent1 (vlax-curve-getstartparam ent1)))
	(setq pt2 (vlax-curve-getpointatparam ent1 (vlax-curve-getendparam ent1)))
	(foreach p1 (list pt1 pt2)
        (setq lst (append lst (list (getlst p1 ent))))
	  )))
    (if (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE")(progn
    (setq i (vlax-curve-getstartparam ent1))
    (while (setq p1 (vlax-curve-getpointatparam ent1 i))
      (setq i (1+ i))
      (setq lst (append lst (list (getlst p1 ent))))
      )))
    (if (wcmatch (setq tt (cdr (assoc 0 (entget ent1)))) "ARC,CIRCLE") (progn
    (if (= tt "CIRCLE") (setq p  (vla-get-circumference (vlax-ename->vla-object ent1))))
    (if (= tt "ARC")  (setq p  (vla-get-arclength (vlax-ename->vla-object ent1))))
    (setq  i 0)
    (while (< i p)
      (setq p1 (vlax-curve-getpointatdist ent1 i))
      (setq i (+ 0.1 i))
      (setq lst (append lst (list (getlst p1 ent))))
      )))
    (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))))
    (setq lst2 (append lst2 (list (list (vlax-ename->vla-object ent1) (cadr (car lst)) (caddr (car lst))))))
    ) ss)
  (Mapcar '(lambda (lst)(vla-Move (car lst) (vlax-3d-point (cadr lst)) (vlax-3d-point (caddr lst)))) lst2)
  ))
  (princ))

Đối với ARC và CIRCLE mới lấy được tiếp tuyến tại điểm có độ chính xác 0.1, k biết các bác có ý tưởng nào hay hơn về vấn đề này ? 

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

Doan Van Ha    3.202

Doan Van Ha
Đã đăng

Trên CV tôi đã từng giải bài toán "Vẽ tiếp tuyến của 1 circle, biết rằng nó song song với 1 line cho trước" chính xác luôn, giờ không biết nó nằm ở đâu. Áp dụng nó vào đây là OK.

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

ngokiet    169

ngokiet
Đã đăng
1 giờ} trướ}c, Doan Nguyen Van đã nói: 

(defun c:mm (/ getlst ss n ent osm lst2 lst ent1 pt1 pt2 tt p1 i x y)
  (defun getlst (p1 ent / p2 dis)
      (setq p2 (vlax-curve-getClosestPointToProjection ent p1 (list 0 1 0) ))
      (setq dis (distance p1 p2))
      (list dis p1 p2)	)
  (if(setq ss (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE,LINE,CIRCLE,ARC"))))) (progn (setq n 0)
(mapcar '(lambda (x) (if (= (cdr (assoc 0 (entget x))) "LWPOLYLINE") (if (> (vlax-curve-getendparam x) n) (progn(setq ent x) (setq n (vlax-curve-getendparam x)))))) ss)
  (setq lst2 (list))
  (Mapcar '(lambda (ent1)
    (setq lst (list))
    (if (= (cdr (assoc 0 (entget ent1))) "LINE") (progn
	(setq pt1 (vlax-curve-getpointatparam ent1 (vlax-curve-getstartparam ent1)))
	(setq pt2 (vlax-curve-getpointatparam ent1 (vlax-curve-getendparam ent1)))
	(foreach p1 (list pt1 pt2)
        (setq lst (append lst (list (getlst p1 ent))))
	  )))
    (if (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE")(progn
    (setq i (vlax-curve-getstartparam ent1))
    (while (setq p1 (vlax-curve-getpointatparam ent1 i))
      (setq i (1+ i))
      (setq lst (append lst (list (getlst p1 ent))))
      )))
    (if (wcmatch (setq tt (cdr (assoc 0 (entget ent1)))) "ARC,CIRCLE") (progn
    (if (= tt "CIRCLE") (setq p  (vla-get-circumference (vlax-ename->vla-object ent1))))
    (if (= tt "ARC")  (setq p  (vla-get-arclength (vlax-ename->vla-object ent1))))
    (setq  i 0)
    (while (< i p)
      (setq p1 (vlax-curve-getpointatdist ent1 i))
      (setq i (+ 0.1 i))
      (setq lst (append lst (list (getlst p1 ent))))
      )))
    (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))))
    (setq lst2 (append lst2 (list (list (vlax-ename->vla-object ent1) (cadr (car lst)) (caddr (car lst))))))
    ) ss)
  (Mapcar '(lambda (lst)(vla-Move (car lst) (vlax-3d-point (cadr lst)) (vlax-3d-point (caddr lst)))) lst2)
  ))
  (princ))

Đối với ARC và CIRCLE mới lấy được tiếp tuyến tại điểm có độ chính xác 0.1, k biết các bác có ý tưởng nào hay hơn về vấn đề này ? 

Tính chính xác theo toán thì mình biết là như vậy (xem hình)

h=(d-r)/sinA 

h: là khoảng cách move

d: Là khoảng cách từ tâm đến đường thắng

r:: Bán kính cung tròn

A: góc của dt so trục y.

Mình test với lisp của bạn thì còn trường hợp như line,arc move xuống mà không dính đỉnh mà cũng không tiếp xúc nữa.(xem hình nhỏ)

Còn theo phương pháp move từ từ thì có thể cải thiện độ chính xác bằng cách dùng vòng lặp chia nhỏ giá trị move.

Untitled-1.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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng (Đă chỉnh sửa) 
(defun c:mm (/ getlst ss n ent osm lst2 lst ent1 pt1 pt2 tt p1 i x y ddau dcuoi ang pt r)
  (defun getlst (p1 ent / p2 dis)
      (setq p2 (vlax-curve-getClosestPointToProjection ent p1 (list 0 1 0) nil ))
      (setq dis (distance p1 p2))
      (list dis p1 p2)	)
  (if (setq ss (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE,LINE,CIRCLE,ARC"))))) (progn (setq n 0)
(mapcar '(lambda (x) (if (= (cdr (assoc 0 (entget x))) "LWPOLYLINE") (if (> (vlax-curve-getendparam x) n) (progn(setq ent x) (setq n (vlax-curve-getendparam x)))))) ss)
  (setq lst2 (list))
  (Mapcar '(lambda (ent1)
    (setq lst (list))
    (if (= (cdr (assoc 0 (entget ent1))) "LINE") (progn
(mapcar '(lambda (x) (setq lst (append lst (list (getlst x ent))))) (list (vlax-curve-getpointatparam ent1 (vlax-curve-getstartparam ent1))
										  (vlax-curve-getpointatparam ent1 (vlax-curve-getendparam ent1))))
      ))
    (if (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE")(progn
    (setq i (vlax-curve-getstartparam ent1))
    (while (setq p1 (vlax-curve-getpointatparam ent1 i))
      (setq i (1+ i))
      (setq lst (append lst (list (getlst p1 ent))))
      ))) 
  (if (wcmatch (setq tt (cdr (assoc 0 (entget ent1)))) "ARC,CIRCLE") (progn
    (setq ddau (vlax-curve-getstartparam ent)
	  dcuoi (vlax-curve-getendparam ent))
    (while (< ddau dcuoi)
      (setq ang (angle (vlax-curve-getpointatparam ent ddau) (vlax-curve-getpointatparam ent (1+ ddau)))
	    ddau (1+ ddau)
	    pt (cdr (assoc 10 (entget ent1)))
	    r (cdr (assoc 40 (entget ent1))))
      (setq p1 (polar pt (+ ang (/ pi 2)) r))
      (if (vlax-curve-getdistatpoint ent1 p1)
      (setq lst (append lst (list (getlst p1 ent)))))
      (setq p1 (polar pt (+ ang (* pi 1.5)) r))
      (if (vlax-curve-getdistatpoint ent1 p1)
      (setq lst (append lst (list (getlst p1 ent)))))
      )
    (if (= tt "ARC") (progn
(mapcar '(lambda (x) (setq lst (append lst (list (getlst x ent))))) (list (vlax-curve-getpointatparam ent1 (vlax-curve-getstartparam ent1))
										  (vlax-curve-getpointatparam ent1 (vlax-curve-getendparam ent1))))
	  ))	       
   ))
    (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))))
    (setq lst2 (append lst2 (list (list (vlax-ename->vla-object ent1) (cadr (car lst)) (caddr (car lst))))))
    ) ss)
  (Mapcar '(lambda (lst) (if (= (car (cadr lst)) (car (caddr lst)))(vla-Move (car lst) (vlax-3d-point (cadr lst)) (vlax-3d-point (caddr lst))))) lst2)
  ))
  (princ))

 

 

Chỉnh sửa theo Doan Nguyen Van
Đã chỉnh sửa

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

ngokiet    169

ngokiet
Đã đăng

Mình thấy là đề bài là điểm gần nhât của đoạn thăng mà. Đâu phải là đỉnh đâu.

Muốn thêm thì xét ngược các đỉnh pline với dt là dc rồi.

Còn hàm vlax-curve-getclosepointtoProjection hình như bác nên thêm tham số nill và xét nếu nằm ngoài pline theo phương trục Y thì ko di chuyển.

Ps. Cái này mình thấy ít có ứng dụng nhiều cho Cad nên như vậy cũng dc rồi. Nếu sai chỗ nào thì sửa thủ công thôi. Nhưng mình nói để biết chỗ nào có thể chạy sai thô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

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
2 giờ trước, ngokiet đã nói:

Mình thấy là đề bài là điểm gần nhât của đoạn thăng mà. Đâu phải là đỉnh đâu.

Muốn thêm thì xét ngược các đỉnh pline với dt là dc rồi.

Còn hàm vlax-curve-getclosepointtoProjection hình như bác nên thêm tham số nill và xét nếu nằm ngoài pline theo phương trục Y thì ko di chuyển.

Ps. Cái này mình thấy ít có ứng dụng nhiều cho Cad nên như vậy cũng dc rồi. Nếu sai chỗ nào thì sửa thủ công thôi. Nhưng mình nói để biết chỗ nào có thể chạy sai thôi.

Hehe, k thấy ông chủ thớt lên hỏi bài nữa, đúng là quên khuấy trường hợp bên ngoài nữa, e thêm điều kiện đó vào rồi, nóng quá mà đầu óc giờ cứ lẫ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

quocmanh04tt    635

quocmanh04tt
Đã đăng
1 giờ trước, Doan Nguyen Van đã nói:

Hehe, k thấy ông chủ thớt lên hỏi bài nữa, đúng là quên khuấy trường hợp bên ngoài nữa, e thêm điều kiện đó vào rồi, nóng quá mà đầu óc giờ cứ lẫn bác ạ ^^

Còn trường hợp này:

Not.png

 

02.png

P/s: Nếu giải quyết hết các trường hợp thì lisp cũng khá dà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

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×