Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
12 replies to this topic

#1 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 29 August 2011 - 09:20 PM

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.c...drawing1_83.dwg
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 30 August 2011 - 07:57 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 August 2011 - 08:01 AM

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.c...drawing1_83.dwg

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

#4 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 30 August 2011 - 11:38 AM

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.
  • 0

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 August 2011 - 11:51 AM

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

#6 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 30 August 2011 - 11:56 AM

Lệnh copym cũng có thể giải quyết được yêu cầu này

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

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 August 2011 - 12:02 PM

Đú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:
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 30 August 2011 - 12:41 PM

:) 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:
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 30 August 2011 - 02:19 PM

:) 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.
  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 30 August 2011 - 02:34 PM

OK, thanks bạn vì mình cũng đang ngại sửa ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 30 August 2011 - 03:48 PM

:) 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.
  • 0

#12 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 August 2011 - 07:10 PM

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))
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 30 August 2011 - 08:00 PM

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 ^^)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC