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

Lisp Copy/Insert các đối tượng hàng loạt

Bởi Duong Nhat Duy , trong AutoLisp

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

Duong Nhat Duy    484

Duong Nhat Duy
Đã đăng

Mình xin chia sẻ 1 Lisp Copy/Insert các đối tượng tự động.
Tên lệnh: CO1

Ý nghĩa: Copy / Insert nhóm đối tượng 1 đến tập hợp điểm của nhóm đối tượng 2.

Nhóm đối tượng 1, Nhóm đối tượng 2: các đối tượng bất kỳ (Block, Text, Pline, Circle, Hatch, Point ...)

Tập hợp điểm: là điểm đặt, đỉnh, trung điểm, trọng tâm, giao cắt... (do người dùng tùy chọn) của Nhóm đối tượng 2.

CO1.LSP

 

Mình đã viết 1 lisp mới cải tiến hơi rất nhiều, có thể thay thế hoàn toàn cho lisp này, các bạn vào đây tham khảo nhé:

 

  • Like 17
  • Vote tăng 6

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

Danh Cong    425

Danh Cong
Đã đăng

+ Lisp kiểu này thường áp dụng cho nhu cầu riêng của cá nhân quá bác ạ :)) Nên mình thấy ko áp dụng rộng rãi với nhiều người . Nhưng cũng thêm 1 "Like" cho 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

Duong Nhat Duy    484

Duong Nhat Duy
Đã đăng
18 phút trước, Danh Cong đã nói:

+ Lisp kiểu này thường áp dụng cho nhu cầu riêng của cá nhân quá bác ạ :)) Nên mình thấy ko áp dụng rộng rãi với nhiều người . Nhưng cũng thêm 1 "Like" cho bác ^^. 

Nhiều mà, mình nghĩ đơn thuần chỉ là copy paste (2 thao tác cơ bản của 1 bản vẽ :))) nên sẽ có khá nhiều mục đích.

  • 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

mr.thanh2610    0

mr.thanh2610
Đã đăng

Hay quá bác ạ, đúng cái em cần, mà bác có thể chỉnh thêm 1 xíu nữa thêm 1 lựa chọn chèn vào trọng tâm 1 hình được không ạ, ví dụ trọng tâm hình chữ nhật, hay hình đa giác bất kì...cảm ơ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

Duong Nhat Duy    484

Duong Nhat Duy
Đã đăng
Vào lúc 7/11/2020 tại 20:49, mr.thanh2610 đã nói:

Hay quá bác ạ, đúng cái em cần, mà bác có thể chỉnh thêm 1 xíu nữa thêm 1 lựa chọn chèn vào trọng tâm 1 hình được không ạ, ví dụ trọng tâm hình chữ nhật, hay hình đa giác bất kì...cảm ơn bác

 

Mình bổ sung r nhé !

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

Nguyen Hoanh    4671

Nguyen Hoanh
Đã đăng

Mình thấy vẫn còn mà

  

(vl-load-com)

(defun C:co1 ( / ANG ANG1 ANG2 DIS ELST ELST_COPY ELST_INTERS ELST_PL ENT ENT1 ETYPE I LEN LST LST1 LST_ADD LST_DIS LST_PT MODE OBJ PT PT1 PT2 PT_BASE ROTP X)
  (princ "Select objects to copy: ")
  (if (and (setq elst_copy (vl-remove-if 'listp (mapcar 'cadr (if (ssget) (ssnamex (ssget "_P")))))) (setq pt_base (getpoint "\nSpecify base point: ")))
    (progn
      (setq elst (vl-remove-if 'listp (mapcar 'cadr (if (ssget) (ssnamex (ssget "_P"))))))
      (setq elst_pl (vl-remove-if-not '(lambda (ent) (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")) elst))
      (setq elst_inters (vl-remove-if-not '(lambda (ent) (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC,CIRCLE")) elst))
      (setq rotp (get_key (list "Yes" "No") "No" "Xoay theo doi tuong"))
      (if elst_inters
	(setq mode (listbox (list "Dinh" "Dau" "Cuoi" "Trung diem" "Trong tam" "Giao cat") "Vi tri Paste cua Pline, Arc" 10 8 1))
	)
      (setq lst_pt nil)
      (foreach ent elst
	(setq lst (entget ent))
	(setq etype (cdr (assoc 0 lst)))
	(setq pt nil)
	(if (wcmatch etype "*TEXT")
	  (if (and (assoc 11 lst)
		   (not (equal (car (cdr (assoc 11 lst))) 0))
		   (not (equal (cadr (cdr (assoc 11 lst))) 0))
		   )
	    (setq pt (cdr (assoc 11 lst)))
	    (setq pt (cdr (assoc 10 lst)))
	    )
	  )
	(if (wcmatch etype "HATCH")
	  (setq pt (boundingbox_centroid ent))
	  )
	(if (not (wcmatch etype "*TEXT,*LINE,ARC,HATCH"))
	  (setq pt (cdr (assoc 10 lst)))
	  )
	(if (not (setq ang (cdr (assoc 50 lst)))) (setq ang 0.0))
	(if pt (setq lst_pt (cons (cons ang pt) lst_pt)))
	)
      (if (member "Dinh" mode)
	(foreach ent elst_pl
	  (if (wcmatch (cdr (assoc 0 (entget ent))) "LINE,ARC")
	    (progn
	      (setq pt1 (vlax-curve-getPointAtParam ent (vlax-curve-getStartParam ent)))
	      (setq ang1 (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt1))))
	      (setq pt2 (vlax-curve-getPointAtParam ent (vlax-curve-getEndParam ent)))
	      (setq ang2 (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt2))))
	      (setq lst_pt (cons (cons ang1 pt1) lst_pt))
	      (setq lst_pt (cons (cons ang2 pt2) lst_pt))
	      )
	    )
	  (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
	    (progn
	      (setq lst_add (mapcar '(lambda (pt) (cons (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))) pt)) (get_vertex ent)))
	      (setq lst_pt (append lst_add lst_pt))
	      )
	    )
	  )
	)
      (if (and (member "Dau" mode) (not (member "Dinh" mode)))
	(foreach ent elst_pl
	  (setq pt (vlax-curve-getPointAtParam ent (vlax-curve-getStartParam ent)))
	  (setq ang (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))))
	  (setq lst_pt (cons (cons ang pt) lst_pt))
	  )
	)
      (if (and (member "Cuoi" mode) (not (member "Dinh" mode)))
	(foreach ent elst_pl
	  (setq pt (vlax-curve-getPointAtParam ent (vlax-curve-getEndParam ent)))
	  (setq ang (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))))
	  (setq lst_pt (cons (cons ang pt) lst_pt))
	  )
	)
      (if (member "Trung diem" mode)
	(progn
	  (foreach ent elst_pl
	    (if (wcmatch (cdr (assoc 0 (entget ent))) "LINE,ARC")
	      (progn
		(setq pt (vlax-curve-getPointAtDist ent (* (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 0.5)))
		(setq ang (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))))
		(setq lst_pt (cons (cons ang pt) lst_pt))
		)
	      )
	    (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
	      (progn
		(setq lst1 (get_vertex ent))
		(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
		(setq lst_dis (mapcar '(lambda (pt) (vlax-curve-getDistAtPoint ent pt)) lst1))
		(if (not (equal len (last lst_dis)))
		  (setq lst_dis (reverse (cons len (cdr (reverse lst_dis)))))
		  )
		(setq i 0)
		(repeat (1- (length lst_dis))
		  (setq dis (* (+ (nth i lst_dis) (nth (1+ i) lst_dis)) 0.5))
		  (setq pt (vlax-curve-getPointAtDist ent dis))
		  (setq ang (angle (list 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))))
		  (setq lst_pt (cons (cons ang pt) lst_pt))
		  (setq i (1+ i))
		  )
		)
	      )
	    )
	  )
	)
      (if (member "Trong tam" mode)
	(setq lst_pt (append lst_pt (mapcar '(lambda (x) (cons 0.0 (poly_centroid x))) elst_pl)))
	)
      (if (member "Giao cat" mode)
	(while (> (length elst_inters) 1)
	  (setq ent1 (car elst_inters))
	  (setq lst (apply 'append (mapcar '(lambda (x) (vla-inters ent1 x acextendnone)) (cdr elst_inters))))
	  (foreach pt lst (setq lst_pt (cons (cons 0.0 pt) lst_pt)))
	  (setq elst_inters (cdr elst_inters))
	  )
	)

      (setq lst_pt (unique lst_pt))
      (foreach lst lst_pt
	(if (and (setq pt (cdr lst)) (setq ang (car lst)))
	  (foreach ent elst_copy
	    (vla-Copy (vlax-ename->vla-object ent))
	    (setq obj (vlax-ename->vla-object (entlast)))
	    (vla-Move obj (vlax-3d-point pt_base) (vlax-3d-point pt))
	    (if (= rotp "Yes") (vla-Rotate obj (vlax-3d-point pt) ang))
	    )
	  )
	)
      )
    )
  (princ)
  )

;NHAP KEYWORD
(defun get_key (key default promp / key_fix str1 str2 str3 str4)
  (setq key_fix key)
  (foreach str1 (list " " "_")
    (setq key_fix (mapcar '(lambda (str) (while (vl-string-search str1 str) (setq str (vl-string-subst "" str1 str))) str) key_fix))
    )
  (setq str1 (apply 'strcat (mapcar (function (lambda (x) (strcat x " "))) key_fix)))
  (setq str2 (apply 'strcat (mapcar (function (lambda (x) (strcat x "/"))) key_fix)))
  (setq str1 (substr str1 1 (1- (strlen str1))))
  (setq str2 (substr str2 1 (1- (strlen str2))))
  (if (not (assoc default (mapcar 'list key_fix))) (setq default (car key_fix)))
  (initget str1)
  (setq str3 (strcat "\n" promp " [" str2 "] <" default "> "))
  (if (not (setq str4 (getkword str3)))
    (nth (vl-position default key_fix) key)
    (nth (vl-position str4 key_fix) key)
    )
  )

;XOA PHAN TU TRUNG
(defun unique (lst)
  (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
  )

;LIST BOX
(defun listbox (lst msg wid hei bit / dch des tmp rtn)
  (if (> (length lst) 1)
    (progn
      (cond
	((not
	   (and
	     (setq tmp (vl-filename-mktemp nil nil ".dcl"))
	     (setq des (open tmp "w"))
	     (write-line
	       (strcat
		 "listbox:dialog{label=\""
		 msg
		 "\";spacer;:list_box{key=\"list\";multiple_select="
		 (if (= 1 (logand 1 bit))
		   "true"
		   "false"
		 )
		 (strcat ";width="
			 (rtos wid 2 0)
			 ";height="
			 (rtos hei 2 0)
			 ";}spacer;ok_cancel;}"
		 )
	       )
	       des
	     )
	     (not (close des))
	     (< 0 (setq dch (load_dialog tmp)))
	     (new_dialog "listbox" dch)
	   )
	 )
	 (prompt "\nError Loading List Box Dialog.")
	)
	(t
	 (start_list "list")
	 (foreach itm lst (add_list itm))
	 (end_list)
	 (setq rtn (set_tile "list" "0"))
	 (action_tile "list" "(setq rtn $value)")
	 (setq rtn
		(if (= 1 (start_dialog))
		  (if (= 2 (logand 2 bit))
		    (read (strcat "(" rtn ")"))
		    (mapcar '(lambda (x) (nth x lst))
			    (read (strcat "(" rtn ")"))
		    )
		  )
		)
	 )
	)
      )
      (if (< 0 dch)
	(unload_dialog dch)
      )
      (if (and tmp (setq tmp (findfile tmp)))
	(vl-file-delete tmp)
      )
      rtn
    )
    lst
    )
  )

;GET VERTEX
(defun get_vertex (ent / i lst)
  (setq i 0)
  (repeat (fix (1+ (vlax-curve-getEndParam ent)))
    (setq lst (append lst (list (vlax-curve-getPointAtParam ent i))))
    (setq i (1+ i))
    )
  lst
  )

;GIAO CAT
(defun vla-inters (ent1 ent2 mode / lst1 lst2)
  (setq lst1 (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2)
	       (cond
		 ((= mode 0) acextendnone)
		 ((= mode 1) acextendthisentity)
		 ((= mode 2) acextendotherentity)
		 ((= mode 3) acextendboth)
		 )))
  (repeat (/ (length lst1) 3)
    (setq lst2 (cons (list (car lst1) (cadr lst1) (caddr lst1)) lst2)
	  lst1 (cdddr lst1)
	  )
    )
  (reverse lst2)
  )

;CENTROID
(defun boundingbox_centroid (ent / minpt maxpt)
  (if
    (and
      (vlax-method-applicable-p (vlax-ename->vla-object ent) 'getboundingbox)
      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list (vlax-ename->vla-object ent) 'minpt 'maxpt))))
      (setq minpt (vlax-safearray->list minpt))
      (setq maxpt (vlax-safearray->list maxpt))
      )
    (list (* 0.5 (+ (car minpt) (car maxpt))) (* 0.5 (+ (cadr minpt) (cadr maxpt))))
    )
  )

;POLY CENTROID - LEE MAC
(defun poly_centroid (e / l)
  (foreach x (setq e (entget e))
    (if	(= 10 (car x))
      (setq l (cons (cdr x) l))
    )
  )
  (
   (lambda (a)
     (if (not (equal 0.0 a 1e-8))
       (trans
	 (mapcar
	   '/
	   (apply
	     'mapcar
	     (cons '+
		   (mapcar
		     (function
		       (lambda (a b)
			 (
			  (lambda (m)
			    (mapcar
			      (function
				(lambda (c d) (* (+ c d) m))
			      )
			      a
			      b
			    )
			  )
			   (- (* (car a) (cadr b)) (* (car b) (cadr a)))
			 )
		       )
		     )
		     l
		     (cons (last l) l)
		   )
	     )
	   )
	   (list a a)
	 )
	 (cdr (assoc 210 e))
	 0
       )
     )
   )
    (* 3.0
       (apply '+
	      (mapcar
		(function
		  (lambda (a b)
		    (- (* (car a) (cadr b)) (* (car b) (cadr a)))
		  )
		)
		l
		(cons (last l) l)
	      )
       )
    )
  )
)

 

  • 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

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
×