Đến nội dung


Hình ảnh
- - - - -

Nhờ Viêt Lisp Di Chuyển Đối Tượng Với Khoảng Cách Đều


  • Please log in to reply
9 replies to this topic

#1 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 26 August 2015 - 10:45 AM

Nhờ các anh viết giúp mình Lisp để di chuyển các đối tượng thẳng hàng và cách đều nhau như hình. Cảm ơn!

 

Yêu cầu:

- Chọn nhóm đối tượng donut cần xếp

- Di chuyển các đối tượng về thẳng hàng theo phương của 2 đối tượng đầu và cuối. Các đối tượng ở giữa cách đều nhau.

 

2251976_Untitled.jpg

 

File đính kèm:

http://www.cadviet.c...46_file_mau.dwg


  • -1

#2 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 26 August 2015 - 10:55 AM

Nhờ các anh viết giúp mình Lisp để di chuyển các đối tượng thẳng hàng và cách đều nhau như hình. Cảm ơn!

 

Yêu cầu:

- Chọn nhóm đối tượng donut cần xếp

- Di chuyển các đối tượng về thẳng hàng theo phương của 2 đối tượng đầu và cuối. Các đối tượng ở giữa cách đều nhau.

 

2251976_Untitled.jpg

 

File đính kèm:

http://www.cadviet.c...46_file_mau.dwg

Hề hề hề,

Vấn đề là bạn cần phải xác định đâu là đối tượng đầu và đâu là đối tượng cuối.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 anti lazy

anti lazy

    biết lệnh erase

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

Đã gửi 26 August 2015 - 11:06 AM

Thay vì lười biếng, xin xỏ  thì hãy động não và chịu khó search 1 tí.
Xóa các đối tượng rồi dùng lisp rải đối tượng theo đường dẫn


  • 0

#4 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 26 August 2015 - 02:20 PM

Cảm ơn các anh đã phản hồi!

 

Ở trường hợp của mình thì các đối tượng có sẳn, nó được tạo ra bởi phần mềm khác chạy trên AutoCAD. Vì thế nó chỉ có thể Move và Copy chứ không được xóa.

 

Để xác định đối tượng ở đầu và cuối thì theo mình chọn đối tượng cao nhất và thấp nhất theo 2 trục X, Y (trong tập lựa chọn)

 

Mình cũng đã tìm kiếm nhưng do ko rành về lisp nên nhờ các anh hỗ trợ giúp!

 

Thân!


  • 0

#5 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 642 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 26 August 2015 - 03:35 PM

bạn có thể dùng thử

(defun c:cadviet(/ A ANG B DELTA DI DT
DT_CUOI DT_DAU K LST N P1 P2 R SS)
(vl-load-com)
(setvar "cmdecho" 0)
(defun trongtam_Donut(dt)
(setq ent (entget dt))
(setq ls10 (vl-remove-if '(lambda(x)(/= (car x)10)) ent))
(mapcar '(lambda(x y)
(* 0.5 (+ x y)))
(cdr (car ls10))(cdr (last ls10))))

(setq ss (ssget '((0 . "LWPOLYLINE")(70 . 1)(90 . 2))))
(setq lst (vl-sort (acet-ss-to-list ss)
'(lambda (x y)
(if (not (equal
(car (setq Gx (trongtam_Donut x)))
(car (setq Gy (trongtam_Donut y)))
1E-3))
(< (cadr Gx) (cadr Gy))
(< (car Gx) (car Gy))
)
)
))
(setq dt_dau (car lst)
dt_cuoi (last lst)
N (- (length lst) 1)
di (distance (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
ang (angle (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
delta (/ di N 1.000)
r '()
k -1)
(foreach dt lst
(setq r (append r (list
(list
dt
(trongtam_Donut dt)
(polar (trongtam_Donut dt_dau) ang (* (setq k (1+ k)) delta))
)))))
(setq dt (car r))
(command "undo" "begin")
(foreach dt r
(command "move" (car dt) "" "_non" (cadr dt) "_non" (last dt)))
(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)

Bài viết đã được chỉnh sửa nội dung bởi quansla: 26 August 2015 - 03:50 PM

  • 1

#6 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 26 August 2015 - 04:35 PM

Cảm ơn anh quansla đã code giúp! Mình đã dùng thử được kết quả như hình. 

 

Untitled81ebb.jpg

 

Nhờ anh chỉnh lại cho nó sắp xếp theo phương của đối tượng đầu và đối tượng cuối.


  • 0

#7 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 27 August 2015 - 07:46 AM

Cảm ơn anh đã code giúp! Mình đã dùng thử được kết quả như hình. 

 

Untitled81ebb.jpg

 

Nhờ anh chỉnh lại cho nó sắp xếp theo phương của đối tượng đầu và đối tượng cuối.

chắc là thế này :

(defun c:cadviet(/ A ANG B DELTA DI DT DT_CUOI DT_DAU K LST N P1 P2 R SS)
(vl-load-com)
;;;(setvar "cmdecho" 0)
  (defun trongtam_Donut(dt)
    (setq ent (entget dt))
    (setq ls10 (vl-remove-if '(lambda(x)(/= (car x)10)) ent))
    (mapcar '(lambda(x y)
	       (* 0.5 (+ x y)))
	    (cdr (car ls10))(cdr (last ls10))))

  (setq ss (ssget '((0 . "LWPOLYLINE")(70 . 1)(90 . 2))))
  (setq lst (vl-sort (acet-ss-to-list ss)
		     '(lambda (x y) (< (car (trongtam_Donut x)) (car (trongtam_Donut y)))) ))
  (setq dt_dau (car lst)
	dt_cuoi (last lst)
	N (- (length lst) 1)
	di (distance (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
	ang (angle (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
	delta (/ di N 1.000)
	r '() k -1)
  (foreach dt lst
    (setq r (append r (list(list dt (trongtam_Donut dt)
				 (polar (trongtam_Donut dt_dau) ang (* (setq k (1+ k)) delta)))))))
  (setq dt (car r))
  (command "undo" "begin")
  (foreach dt r
    (command "move" (car dt) "" "_non" (cadr dt) "_non" (last dt)))
  (command "undo" "end")
;;;  (setvar "cmdecho" 1)
  (princ))

  • 1

#8 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 27 August 2015 - 08:21 AM

May mắn là bản vẽ hainguyen2014 có sẵn 2 donut tại đầu và cuối đường dẫn nên  Lisp  đúng trong trường hợp này. Tổng quát hơn chắc phải chọn  đường dẫn rồi mới quét chọn các Donut :) . Từ code có sẵn của bạn quansla, code lại theo ý tưởng đó :D :

(defun c:cadviet (/ cur ss lst n i L lr) (vl-load-com)
(defun trongtam_Donut (dt / ent ls10)
(setq ent (entget dt)) (setq ls10 (vl-remove-if '(lambda (x) (/= (car x) 10)) ent))
(mapcar '(lambda (x y) (* 0.5 (+ x y))) (cdr (car ls10)) (cdr (last ls10))) ) 

(command "undo" "be") (setq cur (car (entsel "Chon path curve :")))
(princ "Chon cac Donut :") (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 2))))
(setq lst (acet-ss-to-list ss) n (length lst) i 0) 
(setq L (vlax-curve-getDistAtPoint cur (vlax-curve-getendpoint cur)))
(foreach dt lst (setq lr (append lr (list (list dt (trongtam_Donut dt) 
(vlax-curve-getPointAtDist cur (/ (* i L) (1- n))) )))) (setq i (1+ i)) )
(foreach x lr (vla-move (vlax-ename->vla-object (car x)) (vlax-3d-point (cadr x)) 
(vlax-3d-point (last x)) ))
(command "undo" "e") (princ))


  • 1

#9 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 27 August 2015 - 08:31 AM

 

chắc là thế này :

(defun c:cadviet(/ A ANG B DELTA DI DT DT_CUOI DT_DAU K LST N P1 P2 R SS)
(vl-load-com)
;;;(setvar "cmdecho" 0)
  (defun trongtam_Donut(dt)
    (setq ent (entget dt))
    (setq ls10 (vl-remove-if '(lambda(x)(/= (car x)10)) ent))
    (mapcar '(lambda(x y)
	       (* 0.5 (+ x y)))
	    (cdr (car ls10))(cdr (last ls10))))

  (setq ss (ssget '((0 . "LWPOLYLINE")(70 . 1)(90 . 2))))
  (setq lst (vl-sort (acet-ss-to-list ss)
		     '(lambda (x y) (< (car (trongtam_Donut x)) (car (trongtam_Donut y)))) ))
  (setq dt_dau (car lst)
	dt_cuoi (last lst)
	N (- (length lst) 1)
	di (distance (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
	ang (angle (trongtam_Donut dt_dau)(trongtam_Donut dt_cuoi))
	delta (/ di N 1.000)
	r '() k -1)
  (foreach dt lst
    (setq r (append r (list(list dt (trongtam_Donut dt)
				 (polar (trongtam_Donut dt_dau) ang (* (setq k (1+ k)) delta)))))))
  (setq dt (car r))
  (command "undo" "begin")
  (foreach dt r
    (command "move" (car dt) "" "_non" (cadr dt) "_non" (last dt)))
  (command "undo" "end")
;;;  (setvar "cmdecho" 1)
  (princ))

 

Cảm ơn anh gia_bach đã giải bài toán này giúp mình. 


  • 0

#10 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 27 August 2015 - 08:37 AM

 

May mắn là bản vẽ hainguyen2014 có sẵn 2 donut tại đầu và cuối đường dẫn nên  Lisp  đúng trong trường hợp này. Tổng quát hơn chắc phải chọn  đường dẫn rồi mới quét chọn các Donut :) . Từ code có sẵn của bạn quansla, code lại theo ý tưởng đó :D :

(defun c:cadviet (/ cur ss lst n i L lr) (vl-load-com)
(defun trongtam_Donut (dt / ent ls10)
(setq ent (entget dt)) (setq ls10 (vl-remove-if '(lambda (x) (/= (car x) 10)) ent))
(mapcar '(lambda (x y) (* 0.5 (+ x y))) (cdr (car ls10)) (cdr (last ls10))) ) 

(command "undo" "be") (setq cur (car (entsel "Chon path curve :")))
(princ "Chon cac Donut :") (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 2))))
(setq lst (acet-ss-to-list ss) n (length lst) i 0) 
(setq L (vlax-curve-getDistAtPoint cur (vlax-curve-getendpoint cur)))
(foreach dt lst (setq lr (append lr (list (list dt (trongtam_Donut dt) 
(vlax-curve-getPointAtDist cur (/ (* i L) (1- n))) )))) (setq i (1+ i)) )
(foreach x lr (vla-move (vlax-ename->vla-object (car x)) (vlax-3d-point (cadr x)) 
(vlax-3d-point (last x)) ))
(command "undo" "e") (princ))

 

Cảm ơn anh pphung183 đã trợ giúp. 

Đường dẫn (line) trong file mục đích để kiểm tra thôi, không sử dụng để xác định phương. hi


  • 0