Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hugo007

[Yêu cầu] Lisp chia khoảng cách giữa 2 đối tượng là donut

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

Nhờ các bác viết giùm mình đoạn lisp,mình có 2 donut khi đánh lệnh lisp sẽ kêu chọn donut,sau khi chọn sẽ hỏi chia làm mấy,chọn xong nó lisp sẽ tự động chia khoảng cách giữa 2 donut thành những phần bằng nhau,ngăn cách giữa các phần bằng nhau chính là donut đó.Ví dụ donut A cách donut B 6m ,chia làm 3 phần bằng nhau,sau khi chọn các bước trên,từ A cách khoảng 2m về phía đối tượng B là 1 donut,4m là 1 donut nữa.Vì nếu dùng lệnh DIVIDE thì phải vẽ đường thẳng từ A đến B mới chia được và sau đó phải xoá đường thẳng đi,mất thời gian.(Khoảng cách từ từ tâm donut này đến tâm donut kia).Chân thành cảm ơn trước.

Đây là file đính kèm:

http://www.cadviet.com/upfiles/3/drawing1_83.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

Chúc bạn vui :ph34r:

;Chia donut theo khoang cach giua 2 donut da chon
(defun c:test (/ lstVar lstVal dump ST:Geom-Center)
(setq lstVar '("osmode" "cmdecho")
  lstVal (mapcar 'getvar lstVar)
  dump (mapcar 'setvar lstVar '(0 0))
)
(grtext -1 "Free Lisp from CADViet @Ketxu")
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
((lambda (ss number i / ent1 ent2 P1 P2 n dis ang )
(if (and (= (sslength ss) 2)(> number 1))
	(progn
		(setq ent1 (ssname ss 0) ent2 (ssname ss 1) 
				P1  (ST:Geom-Center ent1)
				P2  (ST:Geom-Center ent2)					
				n (1- number)
				dis (/ (distance P1 P2) number)
				ang (angle P1 P2)
		)	
	(repeat n
	(command ".copy" ent1 "" P1 (polar P1 ang (* (setq i (1+ i)) dis)))		
	)
	)(Princ "Wrong! Do again!")
)
)
(ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1)))
(getint "\n Number Divide :")
0)
(mapcar 'setvar lstVar lstVal)
)

t

  • 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

Nhờ các bác viết giùm mình đoạn lisp,mình có 2 donut khi đánh lệnh lisp sẽ kêu chọn donut,sau khi chọn sẽ hỏi chia làm mấy,chọn xong nó lisp sẽ tự động chia khoảng cách giữa 2 donut thành những phần bằng nhau,ngăn cách giữa các phần bằng nhau chính là donut đó.Ví dụ donut A cách donut B 6m ,chia làm 3 phần bằng nhau,sau khi chọn các bước trên,từ A cách khoảng 2m về phía đối tượng B là 1 donut,4m là 1 donut nữa.Vì nếu dùng lệnh DIVIDE thì phải vẽ đường thẳng từ A đến B mới chia được và sau đó phải xoá đường thẳng đi,mất thời gian.(Khoảng cách từ từ tâm donut này đến tâm donut kia).Chân thành cảm ơn trước.

Đây là file đính kèm:

http://www.cadviet.com/upfiles/3/drawing1_83.dwg

Bạn có thể sử dụng lệnh copym. (1 lệnh trong phụ trợ Express)

  • 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

Chúc bạn vui :ph34r:

;Chia donut theo khoang cach giua 2 donut da chon
(defun c:test (/ lstVar lstVal dump ST:Geom-Center)
(setq lstVar '("osmode" "cmdecho")
  lstVal (mapcar 'getvar lstVar)
  dump (mapcar 'setvar lstVar '(0 0))
)
(grtext -1 "Free Lisp from CADViet @Ketxu")
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
((lambda (ss number i / ent1 ent2 P1 P2 n dis ang )
(if (and (= (sslength ss) 2)(> number 1))
	(progn
		(setq ent1 (ssname ss 0) ent2 (ssname ss 1) 
				P1  (ST:Geom-Center ent1)
				P2  (ST:Geom-Center ent2)					
				n (1- number)
				dis (/ (distance P1 P2) number)
				ang (angle P1 P2)
		)	
	(repeat n
	(command ".copy" ent1 "" P1 (polar P1 ang (* (setq i (1+ i)) dis)))		
	)
	)(Princ "Wrong! Do again!")
)
)
(ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1)))
(getint "\n Number Divide :")
0)
(mapcar 'setvar lstVar lstVal)
)

t

Cảm ơn ketxu rất nhiều,nhờ bác thêm giùm chức năng đầu tiên hỏi DIVIDE hay ARRAY nếu DIVIDE thì thực hiện như yêu cầu đầu của mình,còn chọn ARRAY thì hỏi khoảng cách các donut,sau khi nhập nó sẽ ARRAY các donut này ra khoảng các vừa nhập trong khoảng 2 donut đã chọn.Ví dụ có 2 donut cách nhau 2000 nếu nhập khoảng ARRAY là 200 thì sẽ tạo ra 9 donut cách nhau 200 giữa 2 donut vừa chọn.Phiề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

Cảm ơn ketxu rất nhiều,nhờ bác thêm giùm chức năng đầu tiên hỏi DIVIDE hay ARRAY nếu DIVIDE thì thực hiện như yêu cầu đầu của mình,còn chọn ARRAY thì hỏi khoảng cách các donut,sau khi nhập nó sẽ ARRAY các donut này ra khoảng các vừa nhập trong khoảng 2 donut đã chọn.Ví dụ có 2 donut cách nhau 2000 nếu nhập khoảng ARRAY là 200 thì sẽ tạo ra 9 donut cách nhau 200 giữa 2 donut vừa chọn.Phiền bác.

Lệnh copym cũng có thể giải quyết được yêu cầu 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

Đúng bác,nhưng nó không nhanh hơn lisp bác ah.

Lệnh copym xuất thân từ Lisp chứ đâu?

Hơn nữa, nó có thể chia được nhiều đối tượng khác nữa, không chỉ là Donut. Và có nhiều tuỳ chọn nữa.

Không lẽ cứ phải chia 1 đối tượng khác lại phải thêm 1 cái Lisp nữa.

=> Bao nhiêu Lisp mới đủ? :rolleyes:

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

:) Mình dần dần thấy yêu cầu của bạn giồng copyarray rồi đó ^^ Nhưng thôi, cố thì cố cho trót, lần sau hi vọng bạn nói đầy đủ yêu cầu luôn từ đầu :

(defun c:test (/ lstVar lstVal dump ST:Geom-Center ss ent1 ent2 p1 p2 i n dis)
(grtext -1 "Free lisp from CadViet @Ketxu")
(setq lstVar '("osmode" "cmdecho")
  lstVal (mapcar 'getvar lstVar)
  dump (mapcar 'setvar lstVar '(0 0))
)
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
(or ans (setq ans "D"))
(setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1))))
(initget "A D")
(setq ans (cond ((getkword (strcat  "\nDivied (D) / Array (A) < " ans " > : ") ))(ans)))
(if (= (sslength ss) 2)
	(progn
		(setq ent1 (ssname ss 0) ent2 (ssname ss 1) 
				P1  (ST:Geom-Center ent1)
				P2  (ST:Geom-Center ent2)					
				ang (angle P1 P2)
				i 0
		)
		(cond ((wcmatch ans "D") (setq n (1- (setq number (getint "\nNumber Divide :"))) dis (/ (distance P1 P2) number)))
				(T (setq dis (getreal "\nLeng to array : ") n (	fix (+ (/ (distance P1 P2)	dis) 1e-8))))
		)				
	(repeat n
	(command ".copy" ent1 "" P1 (polar P1 ang (* (setq i (1+ i)) dis)))		
	)
	)(Princ "Wrong! Do again!")
)
)

!

P/S : giờ mới đọc lại yêu cầu, các donut tạo ra chưa nằm giữa 2 donut, các bác khác sửa giúp e với hén, e phải đi khổ sai đây :wacko:

  • 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

:) Mình dần dần thấy yêu cầu của bạn giồng copyarray rồi đó ^^ Nhưng thôi, cố thì cố cho trót, lần sau hi vọng bạn nói đầy đủ yêu cầu luôn từ đầu :

(defun c:test (/ lstVar lstVal dump ST:Geom-Center ss ent1 ent2 p1 p2 i n dis)
(grtext -1 "Free lisp from CadViet @Ketxu")
(setq lstVar '("osmode" "cmdecho")
  lstVal (mapcar 'getvar lstVar)
  dump (mapcar 'setvar lstVar '(0 0))
)
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
(or ans (setq ans "D"))
(setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1))))
(initget "A D")
(setq ans (cond ((getkword (strcat  "\nDivied (D) / Array (A) < " ans " > : ") ))(ans)))
(if (= (sslength ss) 2)
	(progn
		(setq ent1 (ssname ss 0) ent2 (ssname ss 1) 
				P1  (ST:Geom-Center ent1)
				P2  (ST:Geom-Center ent2)					
				ang (angle P1 P2)
				i 0
		)
		(cond ((wcmatch ans "D") (setq n (1- (setq number (getint "\nNumber Divide :"))) dis (/ (distance P1 P2) number)))
				(T (setq dis (getreal "\nLeng to array : ") n (	fix (+ (/ (distance P1 P2)	dis) 1e-8))))
		)				
	(repeat n
	(command ".copy" ent1 "" P1 (polar P1 ang (* (setq i (1+ i)) dis)))		
	)
	)(Princ "Wrong! Do again!")
)
)

!

P/S : giờ mới đọc lại yêu cầu, các donut tạo ra chưa nằm giữa 2 donut, các bác khác sửa giúp e với hén, e phải đi khổ sai đây :wacko:

Cảm ơn bác nhiều,lisp quá tốt,khi chọn DIVIDE tạo donut nằm tại các điểm chia đều giữa 2 donut ,ARRAY thì cách khoảng theo yêu cầu nhập vào,đâu cần donut nằm giữa 2 donut bác.1 lần nữa cảm ơn bác 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

:) Mình dần dần thấy yêu cầu của bạn giồng copyarray rồi đó ^^ Nhưng thôi, cố thì cố cho trót, lần sau hi vọng bạn nói đầy đủ yêu cầu luôn từ đầu :

(defun c:test (/ lstVar lstVal dump ST:Geom-Center ss ent1 ent2 p1 p2 i n dis)
(grtext -1 "Free lisp from CadViet @Ketxu")
(setq lstVar '("osmode" "cmdecho")
  lstVal (mapcar 'getvar lstVar)
  dump (mapcar 'setvar lstVar '(0 0))
)
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
(or ans (setq ans "D"))
(setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1))))
(initget "A D")
(setq ans (cond ((getkword (strcat  "\nDivied (D) / Array (A) < " ans " > : ") ))(ans)))
(if (= (sslength ss) 2)
	(progn
		(setq ent1 (ssname ss 0) ent2 (ssname ss 1) 
				P1  (ST:Geom-Center ent1)
				P2  (ST:Geom-Center ent2)					
				ang (angle P1 P2)
				i 0
		)
		(cond ((wcmatch ans "D") (setq n (1- (setq number (getint "\nNumber Divide :"))) dis (/ (distance P1 P2) number)))
				(T (setq dis (getreal "\nLeng to array : ") n (	fix (+ (/ (distance P1 P2)	dis) 1e-8))))
		)				
	(repeat n
	(command ".copy" ent1 "" P1 (polar P1 ang (* (setq i (1+ i)) dis)))		
	)
	)(Princ "Wrong! Do again!")
)
)

!

P/S : giờ mới đọc lại yêu cầu, các donut tạo ra chưa nằm giữa 2 donut, các bác khác sửa giúp e với hén, e phải đi khổ sai đây :wacko:

Sao dùng xong lại mất hết truy bắt điểm vậy bạn?Thanks.

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

Sao dùng xong lại mất hết truy bắt điểm vậy bạn?Thanks.

Hề hề hề,

Nó mất hết truy bắt điểm vì dòng code này

(setq dump (mapcar 'setvar lstVar '(0 0)))

Bấy giờ bạn muốn phục hồi lại truy bắt điểm cũng như biến cmdecho thì bạn bổ sung vào cuối lisp (trước dấu ngoặc đóng hàm defun) dòng code sau:

(setq dump (mapcar 'setvar lstVar lstval))

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

Sao dùng xong lại mất hết truy bắt điểm vậy bạn?Thanks.

Ồ, lisp đầu có, lúc viết lại mình lại xóa cái dòng đó đi. Bạn làm theo lời bác Bình nhé. Nhét dòng này vào cuối lisp, trước dấu ) cuối cùng :

(mapcar 'setvar lstVar lstVal)

Giá mà các bạn yêu cầu xong bỏ ra 5p mỗi ngày đọc lại cái lisp thì sẽ ít những câu hỏi như thế này hơn ^^ Cứ 1 lỗi nhỏ lại 1 lần post, bị phụ thuộc lắm bạn à (ngày xưa mình cũng thế nên biết 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

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  

×