Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
ketxu

Căn lề text + Mtext, Căn lề đối tượng

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

Cám ơn bác 18011985 cho đã share, cho mình hỏi là mình thấy nhiều lisp có tích hợp luôn dcl trong đó vd chạy 1 lisp là hiện ra hộp thoại luôn còn mình thấy ae vẫn viết dcl ra 1 file riêng. Không biết ưu nhược của vấn đề đó ntn!

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 bác 18011985 cho đã share, cho mình hỏi là mình thấy nhiều lisp có tích hợp luôn dcl trong đó vd chạy 1 lisp là hiện ra hộp thoại luôn còn mình thấy ae vẫn viết dcl ra 1 file riêng. Không biết ưu nhược của vấn đề đó ntn!

Dạng lisp đó là đóng gói hoàn thiện của các file LSP,DCL riêng rẽ.Tất nhiên, chỉnh xửa phải là chỉnh xửa từ file DCL + lsp gốc rồi mới đóng gói lại 1 file ^^.Với 1 lisp dạng *.vlx đã tích hợp hộp thoại thì ưu điểm là gọn, nhẹ, tiện, bảo mật hơn và đỡ rườm rà. Nhược điểm là bớt được thanks do không phải là mã nguồn mở :undecided:).

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ủa ketxu mình hiểu nhưng ý mình là mình gặp file lisp(.lsp not .vlx), run file lisp này thì nó chạy luôn ra hộp thoại, có thể đó là một cách lập trình hay hơn chăng.

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ủa ketxu mình hiểu nhưng ý mình là mình gặp file lisp(.lsp not .vlx), run file lisp này thì nó chạy luôn ra hộp thoại, có thể đó là một cách lập trình hay hơn chăng.

Cái này theo mình hiểu là tạo 1 file .dcl tạm ngay trong Lisp và gọi nó lên ngay trong Lisp.

Tuy nhiên viết dcl ngay trong lsp thì phức tạp hơn và khó quản lý hơn. Tuy nhiên, việc quản lý file thì dễ dàng hơn, chỉ cần Load Lisp là có thể sử dụng được

Còn việc viết Dcl và Lisp riêng rẽ thì cách viết DCL dễ dàng hơn. tuy nhiên phải chỉ rõ đường dẫn của DCL (hoặc DCL phải năm trong Support file Search Path) thì Lísp mới gọi DCL lên được

 

Cái nào cũng có ưu và nhược điểm của nó vậy.

  • 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
Ý của ketxu mình hiểu nhưng ý mình là mình gặp file lisp(.lsp not .vlx), run file lisp này thì nó chạy luôn ra hộp thoại, có thể đó là một cách lập trình hay hơn chăng.

À, đó là dạng lisp có đoạn code tạo DCL động, bác gia_bach có làm ví dụ 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
Ah cho mình hỏi file dcl dùng font j vậy?

Mình dùng Vntime bạn dùng notepad chuyển sang vntime là đọc được thôi (tích hợp với cad 2004 còn Cad cao hơn không hỗ trợ tiếng việt nữa roài). Vẫn đang nghiên cứu để có tiếng việt trong Cad đời sau.

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

hì hì bác bảo em ém thì em post lsp lên làm chi. Mà post lên Cadviet em đã bỏ phần kiểm tra key bản quyền rùi mà. Mặc dù lsp này thì trên Internet thì vô vàn cách nhưng em vẫn muốn giữ một tý ty cho mình khì khì. Mà cái em viết chắc các bác cười em sái quai hàm lun. Nhưng kết quả okie là em zui zào.

Mà thui post lên cho các newbie có thêm tài liệu học tập vậy vì tương lai Cadviet:

Sau đây là file lsp:

;;;-------------------------------- Loading --------------------------------------------(defun c:cc (/ C10 C11 C50 C71 C72 C73 DENT DSS DSSN ENT GOC GOC1 GOC2 H I                      LSP LST M N N10 N11 N50 N71 N72 N73 OB P PT PT1 PT2 PTC SS SSN VT                      DIALOG DOITUONG LETRAI LEPHAI CHINHGIUA PNGANG DANDONG                      SS2ENT XOAYCHU)(defun dialog (/ hanh dcl_id)(while (not (vl-position hanh '(1 0)))(setq dcl_id (load_dialog "Text.DCL"))(if (not (new_dialog "Text" dcl_id))(exit))(action_tile "cancel" "(done_dialog 0)")(action_tile "accept" "(done_dialog 1)")(action_tile "ss" "(done_dialog 2)")(action_tile "lt" "(done_dialog 3)")(action_tile "lp" "(done_dialog 4)")(action_tile "cg" "(done_dialog 5)")(action_tile "cn" "(done_dialog 6)")(action_tile "dan" "(done_dialog 7)")(action_tile "xoay" "(done_dialog 8)")(setq hanh (start_dialog))  (if(= hanh 2)(doituong))  (if(= hanh 3)(letrai))  (if(= hanh 4)(lephai))  (if(= hanh 5)(chinhgiua))  (if(= hanh 6)(pngang))  (if(= hanh 7)(dandong))  (if(= hanh 8)(xoaychu)));while(setq dcl_id (unload_dialog dcl_id)))(defun doituong ()  (setq ss (ssget '((0 . "*TEXT"))))   );;;------------------------ Can chu le trai ------------------------------------(defun letrai ()  (if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq vt (getpoint "\n Chän vÞ trÝ c¨n chØnh: "))      (setq ptc (car vt))      (setq i 0)      (setq n (sslength ss))      (setq m n)      (while (< i n)	(setq ssn (ssname ss (setq m (1- m))))	(setq ent (entget ssn))	(if (= (cdr(assoc 0 ent)) "TEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c73 (assoc 73 ent))    	(setq c72 (assoc 72 ent))    	(setq n73 (cons 73 0))    	(setq n72 (cons 72 0))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n72 c72 ent))    	(setq ent (subst n73 c73 ent))    	(entmod ent)    	    	)  	)	(if (= (cdr(assoc 0 ent)) "MTEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c71 (assoc 71 ent))    	(setq n71 (cons 71 7))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n71 c71 ent))    	(entmod ent)    	    	)  	)        	(setq i (1+ i))	)      (setq ss (ssget "_P"))            )    )    (princ)  );;;------------------------ Can chu le phai ------------------------------------(defun lephai () (if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq vt (getpoint "\n Chän vÞ trÝ c¨n chØnh: "))      (setq ptc (car vt))      (setq i 0)      (setq n (sslength ss))      (setq m n)      (while (< i n)	(setq ssn (ssname ss (setq m (1- m))))	(setq ent (entget ssn))	(if (= (cdr(assoc 0 ent)) "TEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq c11 (cdr (assoc 11 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq n11 (list 11 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c11 (assoc 11 ent))    	(setq c73 (assoc 73 ent))    	(setq c72 (assoc 72 ent))    	(setq n73 (cons 73 0))    	(setq n72 (cons 72 2))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n11 c11 ent))    	(setq ent (subst n72 c72 ent))    	(setq ent (subst n73 c73 ent))    	(entmod ent)    	)  	)	(if (= (cdr(assoc 0 ent)) "MTEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c71 (assoc 71 ent))    	(setq n71 (cons 71 9))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n71 c71 ent))    	(entmod ent)    	)  	)	(setq i (1+ i))	)      (setq ss (ssget "_P"))      )   )  (princ)  );;;------------------------ Can chu giua ------------------------------------(defun chinhgiua ()  (if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq vt (getpoint "\n Chän vÞ trÝ c¨n chØnh: "))      (setq ptc (car vt))      (setq i 0)      (setq n (sslength ss))      (setq m n)      (while (< i n)	(setq ssn (ssname ss (setq m (1- m))))	(setq ent (entget ssn))	(if (= (cdr(assoc 0 ent)) "TEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq c11 (cdr (assoc 11 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq n11 (list 11 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c11 (assoc 11 ent))    	(setq c73 (assoc 73 ent))    	(setq c72 (assoc 72 ent))    	(setq n73 (cons 73 0))    	(setq n72 (cons 72 1))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n11 c11 ent))    	(setq ent (subst n72 c72 ent))    	(setq ent (subst n73 c73 ent))    	(entmod ent)    	)  	)	(if (= (cdr(assoc 0 ent)) "MTEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 ptc (cadr c10) (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c71 (assoc 71 ent))    	(setq n71 (cons 71 8))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n71 c71 ent))    	(entmod ent)    	)  	)	(setq i (1+ i))	)      (setq ss (ssget "_P"))      )  )  (princ)  );;;--------------------------------- Can phuong ngang ----------------------------------------(defun pngang ()(if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq vt (getpoint "\n Chän vÞ trÝ c¨n chØnh: "))      (setq ptc (cadr vt))      (setq i 0)      (setq n (sslength ss))      (setq m n)      (while (< i n)	(setq ssn (ssname ss (setq m (1- m))))	(setq ent (entget ssn))	(if (= (cdr(assoc 0 ent)) "TEXT")  	(progn    	(if (and (= (car(cdr (assoc 11 ent))) 0.0)(= (cadr(cdr (assoc 11 ent))) 0.0)                   	(= (caddr(cdr (assoc 11 ent))) 0.0))      	(progn		(setq c10 (cdr (assoc 10 ent)))		(setq n10 (list 10 (car c10) ptc (caddr c10)))		(setq c10 (assoc 10 ent))		(setq c73 (assoc 73 ent))		(setq c72 (assoc 72 ent))		(setq n73 (cons 73 0))		(setq n72 (cons 72 0))		(setq ent (subst n10 c10 ent))		(setq ent (subst n72 c72 ent))		(setq ent (subst n73 c73 ent))		(entmod ent)		)      	(progn		(setq c10 (cdr (assoc 10 ent)))		(setq n10 (list 10 (car c10) ptc (caddr c10)))		(setq c10 (assoc 10 ent))		(setq c11 (cdr (assoc 11 ent)))		(setq n11 (list 11 (car c11) ptc (caddr c11)))		(setq c11 (assoc 11 ent))		(setq ent (subst n10 c10 ent))		(setq ent (subst n11 c11 ent))		(entmod ent)		)      	)    	)  	)	(if (= (cdr(assoc 0 ent)) "MTEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 (car c10) ptc (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c71 (assoc 71 ent))    	(if(or (= (cdr c71) 1) (= (cdr c71) 4))(progn(setq n71 (cons 71 7))(setq ent (subst n71 c71 ent))))    	(if(or (= (cdr c71) 2) (= (cdr c71) 5))(progn(setq n71 (cons 71 8))(setq ent (subst n71 c71 ent))))    	(if(or (= (cdr c71) 3) (= (cdr c71) 6))(progn(setq n71 (cons 71 9))(setq ent (subst n71 c71 ent))))    	(setq ent (subst n10 c10 ent))    	(entmod ent)    	)  	)	(setq i (1+ i))	)      (setq ss (ssget "_P"))      )  )  (princ)  );;;-------------------------------- Dan dong phuong ngang ----------------------------(defun dandong ()  (if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq n (sslength ss))      (setq vt (getpoint "\n Chän vÞ trÝ c¨n chØnh: "))      (setq h (getreal "\n §é réng cña dßng: "))      (setq ptc (cadr vt))(defun ss2ent (ss / sodt index lstent)  (setq sodt (if ss (sslength ss) 0)	index 0)  (repeat sodt    (setq ent (ssname ss index)  	index (1+ index)  	lstent (cons ent lstent)  	);setq    );repeat  (reverse lstent)  )  (setq i 0)  (setq lst (ss2ent ss));  (setq lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))  (setq lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2)))))))  (foreach e lst    (setq ent (entget e))    (if (= (cdr(assoc 0 ent)) "TEXT")      (progn	(if (and (= (car(cdr (assoc 11 ent))) 0.0)(= (cadr(cdr (assoc 11 ent))) 0.0)                    (= (caddr(cdr (assoc 11 ent))) 0.0))  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 (car c10) ptc (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c73 (assoc 73 ent))    	(setq c72 (assoc 72 ent))    	(setq n73 (cons 73 0))    	(setq n72 (cons 72 0))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n72 c72 ent))    	(setq ent (subst n73 c73 ent))    	(entmod ent)    	    	)         	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 (car c10) ptc (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c11 (cdr (assoc 11 ent)))    	(setq n11 (list 11 (car c11) ptc (caddr c11)))    	(setq c11 (assoc 11 ent))    	(setq ent (subst n10 c10 ent))    	(setq ent (subst n11 c11 ent))    	(entmod ent)	    	)  	);end if	)      (progn	(if (= (cdr(assoc 0 ent)) "MTEXT")  	(progn    	(setq c10 (cdr (assoc 10 ent)))    	(setq n10 (list 10 (car c10) ptc (caddr c10)))    	(setq c10 (assoc 10 ent))    	(setq c71 (assoc 71 ent))    	(if(or (= (cdr c71) 1) (= (cdr c71) 4))(progn(setq n71 (cons 71 7))(setq ent (subst n71 c71 ent))))    	(if(or (= (cdr c71) 2) (= (cdr c71) 5))(progn(setq n71 (cons 71 8))(setq ent (subst n71 c71 ent))))    	(if(or (= (cdr c71) 3) (= (cdr c71) 6))(progn(setq n71 (cons 71 9))(setq ent (subst n71 c71 ent))))    	(setq ent (subst n10 c10 ent))    	(entmod ent)	    	)  	)	)      )    (setq ptc (- ptc h))    )  (setq ss (ssget "_P"))  )    )  (princ)  );;;-----------------------------------------Xoay chu theo duong--------------------------------------------(defun xoaychu ()  (if (= ss nil)(alert "B¹n ch­a chän ®èi t­îng")    (progn      (setq i 0)      (setq pt (getpoint "\n Chän ®­êng chuÈn: "))      (setq dss (ssget pt))      (setq dssn (ssname dss 0))      (setq dent (entget dssn))      (if (= (cdr(assoc 0 dent)) "LINE")	(progn  	(setq pt1 (cdr(assoc 10 dent)))  	(setq pt2 (cdr(assoc 11 dent)))  	(setq goc (angle pt1 pt2))  	(if (and (< (* pi 0.5) goc)(< goc (* pi 1.5)))(setq goc (- goc pi)))  	);end progn	(if (= (cdr(assoc 0 dent)) "POLYLINE")  	(progn    	(setq ob (vlax-ename->vla-object dssn))    	(setq n (vlax-curve-getEndParam ob))    	(setq i 0)    	(setq lsp (list))    	(while (<= i n)      	(setq p (vlax-curve-getPointAtParam ob i))      	(setq lsp (append lsp (list p)))      	(setq i (+ i 1))      	);end progn    	(setq i 0)    	(while (<= i n)      	(if (> i 0)		(progn	  	(setq pt1 (nth (- i 1) lsp))	  	(setq pt2 (nth i lsp))	  	(setq goc1 (angle pt1 pt))	  	(setq goc2 (angle pt pt2))	  	(if(and(or(and(<= (car pt1) (car pt))(<= (car pt) (car pt2)))(and(<= (car pt2) (car pt))                       	(<= (car pt) (car pt1))))(or(and(<= (cadr pt1) (cadr pt))(<= (cadr pt) (cadr pt2)))                       	(and(<= (cadr pt2) (cadr pt))(<= (cadr pt) (cadr pt1))))(or(= goc1 goc2)                       	(< -0.001 (- goc1 goc2))(< -0.001 (- goc2 goc1))))	    	(progn	      	(setq goc (angle pt1 pt2))	      	(if (and (< (* pi 0.5) goc)(< goc (* pi 1.5)))(setq goc (- goc pi)))	      	(setq i (+ 1 n))	      	);end progn	    	);end if	  	);end progn		);end if      	(setq i (1+ i))      	)    	)  	)	)      (setq i 0)      (setq n (sslength ss))      (setq m -1)      (while (< i n)	(setq ssn (ssname ss (setq m (1+ m))))	(setq ent (entget ssn))	(if (or (= (cdr(assoc 0 ent)) "MTEXT") (= (cdr(assoc 0 ent)) "TEXT"))  	(progn    	(setq n50 (cons 50 goc))    	(setq c50 (assoc 50 ent))    	(setq ent (subst n50 c50 ent))    	(entmod ent)    	)  	)	(setq i (1+ i))	);end while      (setq ss ss)      )    )  (princ)  )(dialog)(princ))

Sau đây là file dcl:

Text :dialog {label = "Ch­¬ng tr×nh trî gióp xö lý text";:text {label = "T¸c gi¶: KS.Tr­¬ng §øc H¹nh - C«ng ty t­ vÊn 11";alignment = centered;}:row{:boxed_column{label = "Lùa chän ®èi t­îng";  :row {  :text{label = "Chän ®èi t­îng:"; alignment = left; alignment = centered;  }  :button{label = "Chän";  key = "ss";  width= 10;  fixed_width=true;  }  }:row {  :text{label = "Xoay ®èi t­îng:"; alignment = left; alignment = centered;  }  :button{label = "Xoay";  key = "xoay";  width= 10;  fixed_width=true;  }  }:row {  :text{label = "D·n dßng ph­¬ng ngang:"; alignment = left; alignment = centered;  }  :button{label = "D·n";  key ="dan";  width= 10;  }  }}:boxed_column{label = "Xö lý ®èi t­îng";  :row {  :text{label = "C¨n lÒ tr¸i:"; alignment = left; alignment = centered;  }  :button{label = "VÞ trÝ";  key = "lt";  fixed_width = true;  }  }:row {  :text{label = "C¨n lÒ ph¶i:"; alignment = left; alignment = centered;  }  :button{label = "VÞ trÝ";  key = "lp";  fixed_width = true;  }  }:row {  :text{label = "C¨n chÝnh gi÷a:"; alignment = left; alignment = centered;  }  :button{label = "VÞ trÝ";  key = "cg";  fixed_width = true;  }  }:row {  :text{label = "C¨n ph­¬ng ngang:"; alignment = left; alignment = centered;  }  :button{label = "VÞ trÝ";  key = "cn";  fixed_width = true;  }  }}}ok_only;}

 

Không hiểu sao mình down về 2 file dcl và lisp bỏ vào ổ C load lên rồi mà không có tín hiệu gì???

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 em dung lenh cc lai khong duoc. may' bao' "error: quit / exit abort" la` sao a

Lý do: lisp không tìm ra vị trí của file DCL. Có nhiều cách để xử lý:

- Copy file DCL vào thư mục "Support" của Cad.

- Add Path đến thư mục chứa file DCL.

- ...

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

Lý do: lisp không tìm ra vị trí của file DCL. Có nhiều cách để xử lý:

- Copy file DCL vào thư mục "Support" của Cad.

- Add Path đến thư mục chứa file DCL.

- ...

 

Đã làm theo bác hướng dẫn nhưng đánh lệnh thì vẫn không nhận không biết máy tui có lỗi gì không. Những lisp khác chạy tốt

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

 

Đã làm theo bác hướng dẫn nhưng đánh lệnh thì vẫn không nhận không biết máy tui có lỗi gì không. Những lisp khác chạy tốt

Sau khi đánh lệnh, bạn nhấn F2, rồi copy lên đây xem lỗi gì nào?

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

Dạ đây ạ.

Tôi sử dụng không thấy lỗi, rất có thể trong khi đang sử dụng CC thì bạn cũng đang sử dụng 1 lisp khác nên có thể bị lỗi các biến của lisp CC. Nếu có thể thì bạn up bản vẽ của bạn lên kiểm tra, chắc dễ tìm ra bệnh hơn

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

Giờ là lisp căn lề đối tượng (s).Bao gồm có L,PL,ARC,Dim,Hatch,Block,Att,Point,Text,Mtext,Ellisp,SPline.Code thì dài khỏi nói rồi ^^ Các bác thử test xem sao.(E đã bỏ phần bắt lỗi và các thiết đặt reset setting đi cho đỡ rối mắt r )

(defun c:Trai ( / Set1 Base_X I ObjName Min_X DeltaPt Pt_List_M AttribList AttribFlag)			(setq Set1 (ssget))				(setq ObjName (car (entsel "\n Select Reference Object: ")))		(setq Base_X (caar(GetObjSize_401 ObjName)))	(setq time (getvar "MILLISECS"))	(setq i 0)		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil InsertFlag nil)				(setq ObjName (ssname Set1 i))				(setq Min_X (caar (GetObjSize_401 ObjName)))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list (- Base_X Min_X) 0)))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))		)		(setq time (/ (- (getvar "MILLISECS") time) 1000.0))(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))		(princ))(defun c:Giua ( / Set1 Base_X I ObjName Min_X DeltaPt Pt_List_M AttribList AttribFlag)		(setq Set1 (ssget))			(setq ObjName (car (entsel "\n Select Reference Object: ")))			(setq Pt_List_M(GetObjSize_401 ObjName))	(setq Base_X ( / (+ (caar Pt_List_M)(caadr Pt_List_M)) 2))	(setq i 0)	(setq time (getvar "MILLISECS"))		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil)				(setq ObjName (ssname Set1 i))				(setq Pt_List_M (GetObjSize_401 ObjName))				(setq Min_X ( / (+ (caar Pt_List_M)(caadr Pt_List_M)) 2))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list (- Base_X Min_X) 0)))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))						)						(setq time (/ (- (getvar "MILLISECS") time) 1000.0))(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))		(princ))(defun c:phai ( / Set1 Base_X I ObjName Min_X DeltaPt Pt_List_M AttribList AttribFlag)	(setq Set1 (ssget))					(setq ObjName (car (entsel "\n Select Reference Object: ")))				(setq Pt_List_M(GetObjSize_401 ObjName))	(setq Base_X (caadr Pt_List_M))	(setq i 0)		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil)				(setq ObjName (ssname Set1 i))				(setq Pt_List_M(GetObjSize_401 ObjName))				(setq Min_X (caadr Pt_List_M))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list (- Base_X Min_X) 0)))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))		)		(princ))(defun c:tren ( / Set1 Base_Y I ObjName Min_Y DeltaPt Pt_List_M AttribList AttribFlag)	(setq Set1 (ssget))				(setq ObjName (car (entsel "\n Select Reference Object: ")))			(setq Pt_List_M(GetObjSize_401 ObjName))	(setq Base_Y (cadar Pt_List_M))	(setq i 0)		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil)				(setq ObjName (ssname Set1 i))				(setq Pt_List_M(GetObjSize_401 ObjName))				(setq Min_Y (cadar Pt_List_M))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list 0 (- Base_Y Min_Y))))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))		)		(princ))(defun c:giua1 ( / Set1 Base_Y I ObjName Min_Y DeltaPt Pt_List_M AttribList  AttribFlag)	(setq Set1 (ssget))				(setq ObjName (car (entsel "\n Select Reference Object: ")))				(setq Pt_List_M(GetObjSize_401 ObjName))	(setq Base_Y ( / (+ (cadar Pt_List_M)(cadadr Pt_List_M)) 2))		(setq i 0)		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil)				(setq ObjName (ssname Set1 i))				(setq Pt_List_M(GetObjSize_401 ObjName))				(setq Min_Y ( / (+ (cadar Pt_List_M)(cadadr Pt_List_M)) 2))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list 0 (- Base_Y Min_Y))))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))		)		(princ))(defun c:duoi ( / Set1 Base_Y I ObjName Min_Y DeltaPt Pt_List_M AttribList AttribFlag)	(setq Set1 (ssget))			(setq ObjName (car (entsel "\n Select Reference Object: ")))			(setq Pt_List_M(GetObjSize_401 ObjName))	(setq Base_Y (cadadr Pt_List_M))	(setq i 0)		(repeat (sslength Set1)				(setq Pt_List_M nil Flag2 nil)				(setq ObjName (ssname Set1 i))				(setq Pt_List_M(GetObjSize_401 ObjName))				(setq Min_Y (cadadr Pt_List_M))				(if Flag2 (setq DeltaPt '(0 0))						(setq DeltaPt (list  0 (- Base_Y Min_Y))))						(setq DeltaPt (mapcar '- (trans DeltaPt 1 0 ) (getvar "UCSORG")))				(Entmod_Obj_401 ObjName DeltaPt)						(setq i (1+ i))		)		(princ));;;----------------------------Distribution_401-----------------------(defun Distribution_401 (ObjName /	)			(setq Data (entget ObjName) ObjType (cdr(assoc 0 Data)))	(cond 	((= ObjType "INSERT")(INSERT_Box ObjName))			((= ObjType "HATCH")(HATCH_Box ObjName))			((= ObjType "LINE")(Line_Box ObjName))			((= ObjType "LWPOLYLINE")(LWPOLYLINE_Box ObjName))			((= ObjType "DIMENSION")(DIMENSION_Box ObjName))			((= ObjType "TEXT")(TEXT_Box ObjName))			((= ObjType "MTEXT")(MTEXT_Box ObjName))			((= ObjType "ARC")(ARC_Box ObjName))			((= ObjType "CIRCLE")(CIRCLE_Box ObjName))			((= ObjType "POLYLINE")(POLYLINE_Box ObjName))			((= ObjType "SPLINE")(SPLINE_Box ObjName))			((= ObjType "ELLIPSE")(ELLIPSE_Box ObjName))			((= ObjType "ATTRIB")(setq AttribFlag T)(TEXT_Box ObjName)(setq AttribFlag nil))			((and (= ObjType "ATTDEF") (null InsertFlag))(TEXT_Box ObjName))			((= ObjType "POINT")(POINT_Box ObjName))	)	Pt_List_M);;;===================================================(defun INSERT_Box (ObjName / Ins_P Scale_X Scale_Y Ang AttribList I_NameList)	(setq InsertFlag T)	(setq Ins_P (reverse (cdr (reverse (cdr(assoc 10 (entget ObjName)))))))		(setq Scale_X (cdr(assoc 41 (entget ObjName))))		(setq Scale_Y (cdr(assoc 42 (entget ObjName))))		(setq ScXY (list Scale_X Scale_Y ))	(setq Ang (cdr(assoc 50 (entget ObjName))))		(cond 	((= (cdr(assoc 66 (entget ObjName))) 1)			(setq AttribList (AttribListInsideBlock ObjName))			(mapcar 'Distribution_401 AttribList)			)	)	(setq I_NameList (MakeListInsideBlock ObjName))	(mapcar 'Distribution_401 I_NameList)	(setq Pt_List_M (BoxPoint Pt_List_M))	(setq Ins_P '(0 0) Scale_X 1.0 Scale_Y 1.0 Ang 0))(defun AttribListInsideBlock (ObjName / NextObjType ObjNext )	(setq ObjNext (entnext ObjName))	(while (= (cdr (assoc 0 (entget ObjNext))) "ATTRIB")		(setq AttribList (append AttribList (list ObjNext)))		(if (entnext ObjNext)(setq ObjNext (entnext ObjNext)))	)	AttribList);;;===================================================(defun HATCH_Box (ObjName / )		(Make_Point_List Data)	(if (/= L_Line nil)	(Cal_Line L_Line))	(if (/= L_Arc nil)	(mapcar 'Cal_Arc L_Arc))	(if (/= L_Ellip nil)	(mapcar 'Cal_Ellip L_Ellip))	(if (/= L_Spline nil)(Cal_Spline L_Spline))	(if (/= PL_NoPt nil)(Cal_PL PL_NoPt PL_Pt PL_R))		(setq Pt_List_M (BoxPoint Pt_List_M))	Pt_List_M);;;----------------------------------------------------------------------(defun Make_Point_List ( Data / )	(setq nn (length Data) mm 0)	(while (/= mm nn)		(setq Item (nth mm Data))						(cond 	((and (= (car Item) 92)(= (logand (cdr item) 2) 2))(MakeList_PLine))				((and (= (car Item) 72)(= (cdr Item) 1))(MakeList_Line))				((and (= (car Item) 72)(= (cdr Item) 2))(MakeList_Arc))				((and (= (car Item) 72)(= (cdr Item) 3))(MakeList_Ellip))				((and (= (car Item) 72)(= (cdr Item) 4))(MakeList_Spline))		)		(setq mm (1+ mm))	));;;----------------------------------------------------------------------(defun Cal_PL (PL_NoPt PL_Pt PL_R / j p Pt_List)			(setq PL_Pt (MovRotScl PL_Pt Ins_P Ang Scale_X Scale_Y))			(setq PL_Pt (mapcar '(lambda(x)(trans x 0 1)) PL_Pt))		(setq PL_R (mapcar '(lambda(x)(*	(/ (* Scale_X Scale_Y)(abs (* Scale_X Scale_Y))) x)) PL_R))		(setq j 0)	(foreach Item PL_NoPt		(setq p 1)		(repeat Item			(if (/= p Item)				(setq Pt_List (append Pt_List (list (list (nth j PL_Pt)(nth (1+ j) PL_Pt)(nth j PL_R)))))							(progn 	(setq Pt_List (append Pt_List (list (list (nth j PL_Pt)(nth (- j Item -1) PL_Pt)(nth j PL_R)))))						(setq p 0))			)			(setq j (1+ j) p (1+ p))		)	)	‚Ó‚­‚ç‚Ý‚ª•‰‚Ü‚½‚Í0‚Ìꇂ͌vŽZ‚µ‚È‚¢	(setq Pt_List (vl-remove-if '(lambda(x)(<= (nth 2 x) 0)) Pt_List))	(setq C_Rd_List (mapcar 'CompR Pt_List))		(setq QtPt_List (mapcar '(lambda(x) (QuaterPt (car x)(cadr x))) C_Rd_List))	(setq QtPt_List (apply 'append QtPt_List))		(setq Pt_List (append PL_Pt QtPt_List))	(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List)));;;----------------------------------------------------------------------(defun Cal_Ellip (Pt_List /)	(setq 	P1 (nth 0 Pt_List)			P2 (nth 1 Pt_List)			P2x (car P2)			P2y (cadr P2)			Rate (nth 2 Pt_List)			EPs (nth 3 Pt_List)			EPe (nth 4 Pt_List)			EDrec (nth 5 Pt_List))						(setq EPs (AngleCircleToEllip EPs Rate) EPe (AngleCircleToEllip EPe Rate))			(setq EPsOrg EPs EPeOrg EPe )						(if (= EDrec 0)(setq EPs (- (* 2 pi) EPeOrg) EPe (- (* 2 pi) EPsOrg)))		(setq Pt_List2 (list P1))			(setq Pt_List3(list P2))			(setq Pt_List2 (MovRotScl Pt_List2 Ins_P Ang Scale_X Scale_Y))			(setq Pt_List3 (MovRotScl Pt_List3 '(0 0) Ang Scale_X Scale_Y))		(setq Pt_List2 (mapcar '(lambda(x)(trans x 0 1)) Pt_List2))	(setq Pt_List3 (mapcar '(lambda(x)(trans x 0 1)) Pt_List3))		(if 	(entmake (list	'(0 . "ELLIPSE")'(100 . "AcDbEntity")'(100 . "AcDbEllipse")					(append '(10) (car Pt_List2))(append '(11) (car Pt_List3))(cons 40 Rate)(cons 41 EPs)(cons 42 EPe)))		(setq TempObjName (entlast))(princ "\n Failed in ArcEntEllip"))		(setq 	P2x (caar Pt_List3)			P2y (cadar Pt_List3))			(setq	PEco	(* P2x P2y (- 1 (* Rate Rate)))			PE1x 	(sqrt (+(* P2x P2x)(* Rate Rate P2y P2y)))			PE1y	(/ PEco PE1x)			PE2y	(sqrt (+(* P2y P2y)(* Rate Rate P2x P2x)))			PE2x	(/ PEco PE2y))	(setq 	PE1	(list PE1x PE1y)			PE2	(list PE2x PE2y)			PE3	(mapcar '* PE1 '(-1 -1))			PE4	(mapcar '* PE2 '(-1 -1)))	(setq Pt_List (list PE1 PE2 PE3 PE4))	(setq Pt_List (mapcar '(lambda(x) (mapcar '+  x (car Pt_List2))) Pt_List))		(setq Pt_List (mapcar '(lambda(x)(if (equal (distance (vlax-curve-getClosestPointTo TempObjName x) x ) 0 0.01) x)) Pt_List))	(entdel TempObjName)	·	(setq Pt_List (vl-remove nil Pt_List))		(if Pt_List		(progn	(setq Pt_List (BoxPoint Pt_List))		)	)	(setq Pt_List_M (append Pt_List_M Pt_List)));;;----------------------------------------------------------------------(defun Cal_Arc (Pt_List )		(setq 	P1 (nth 0 Pt_List)			Rd (* (abs Scale_X)(nth 1 Pt_List))			EPs (nth 2 Pt_List)			EPe (nth 3 Pt_List)			Drec (nth 4 Pt_List))	(setq EPsOrg EPs EPeOrg EPe )				(if (= Drec 0)(setq EPs (- (* 2 pi) EPe) EPe (- (* 2 pi) EPsOrg)))				(setq EPs_org EPs EPe_org EPe)				(cond 	((and (< Scale_X 0)(> Scale_Y 0))(setq EPs (- pi EPe_org) 		EPe (- pi EPs_org)))		;X- Y+						((and (< 0 Scale_X)(< Scale_Y 0))(setq EPs (- (* 2 pi) EPe_org)	EPe (- (* 2 pi) EPs_org)))	;X+ Y-						((and (< Scale_X 0)(< Scale_Y 0))(setq EPs (+ pi EPs_org) 		EPe (+ pi EPe_org)))			;X- Y-				)								(setq EPs (+ EPs Ang))				(setq EPe (+ EPe Ang))		(setq Pt_List (list P1))		(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))		(if 	(entmake (list	'(0 . "ARC")'(100 . "AcDbEntity")'(100 . "AcDbCircle")					(append '(10) (car Pt_List))(cons 40 Rd)'(100 . "AcDbArc")(cons 50 EPs)(cons 51 EPe)))		(setq TempObjName (entlast))		(princ "\n Failed in ArcEntmake"))		(setq Pt_List (QuaterPt (car Pt_List) Rd))		(setq Pt_List (mapcar '(lambda(x)(if (equal (distance (vlax-curve-getClosestPointTo TempObjName x) x ) 0 0.00001) x)) Pt_List))	(entdel TempObjName)		(setq Pt_List (vl-remove nil Pt_List))	(if Pt_List		(progn	(setq Pt_List (BoxPoint Pt_List))		)	)			(setq Pt_List_M (append Pt_List_M Pt_List)));;;----------------------------------------------------------------------(defun Cal_Line (Pt_List)	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (BoxPoint Pt_List))			(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun DIMENSION_Box (ObjName);	(princ "\n DIMENSION_Start===============")	(setq I_NameList (MakeListInsideBlock ObjName))	(mapcar '(lambda(x) (Distribution_401 x)) I_NameList)	(setq Pt_List_M (BoxPoint Pt_List_M)));;;===================================================(defun ELLIPSE_Box (ObjName);	(princ "\n ELLIPSE_Box--------------------------")	(setq 	P1 (cdr (assoc 10 Data)) 				P2 (cdr (assoc 11 Data))				P2x (car P2)			P2y (cadr P2)			Rate (cdr (assoc 40 Data))				EPs	(cdr(assoc 41 Data))				EPe	(cdr(assoc 42 Data))			EDrec (nth 3 (assoc 210 Data))			)				(if (or	(and (< Scale_X 0)(< 0 Scale_Y))					(and (< 0 Scale_X)(< Scale_Y 0))				)			(progn	(setq EPs_org EPs)					(setq EPe_org EPe)					(setq EPs (- (* 2 pi) EPe_org))					(setq EPe (- (* 2 pi) EPs_org))))		(setq Pt_List2 (list P1))			(setq Pt_List3(list P2))			(setq Pt_List2 (MovRotScl Pt_List2 Ins_P Ang Scale_X Scale_Y))			(setq Pt_List3 (MovRotScl Pt_List3 '(0 0) Ang Scale_X Scale_Y))		(setq Pt_List2 (mapcar '(lambda(x)(trans x 0 1)) Pt_List2))	(setq Pt_List3 (mapcar '(lambda(x)(trans x 0 1)) Pt_List3))	;ŽÀ'œ‚Ìì¬	(setq Data (subst (append  '(10) (car Pt_List2)) (assoc 10 Data) Data))		(setq Data (subst (append  '(11) (car Pt_List3)) (assoc 11 Data) Data))		(setq Data (subst (cons 41 EPs)(assoc 41 Data) Data))		(setq Data (subst (cons 42 EPe)(assoc 42 Data) Data))		(setq Data (subst (cons 8 "A51")(assoc 8 Data) Data))	(if (entmake Data)(setq TempObjName (entlast))(princ "\n Failed in ArcEntmake"))	(setq Pt1 (vlax-curve-getStartPoint TempObjName))			(setq Pt2 (vlax-curve-getEndPoint TempObjName))				(setq 	P2x (caar Pt_List3)			P2y (cadar Pt_List3))			(setq	PEco	(* P2x P2y (- 1 (* Rate Rate)))			PE1x 	(sqrt (+(* P2x P2x)(* Rate Rate P2y P2y)))			PE1y	(/ PEco PE1x)			PE2y	(sqrt (+(* P2y P2y)(* Rate Rate P2x P2x)))			PE2x	(/ PEco PE2y))	(setq 	PE1	(list PE1x PE1y)			PE2	(list PE2x PE2y)			PE3	(mapcar '* PE1 '(-1 -1))			PE4	(mapcar '* PE2 '(-1 -1)))	(setq Pt_List (list PE1 PE2 PE3 PE4))	(setq Pt_List (mapcar '(lambda(x) (mapcar '+  x (car Pt_List2))) Pt_List))	;‰ñ"]Šg'åŒã‚Ì'†SÀ•W‚ð'«‚·		(setq Pt_List (mapcar '(lambda(x)(if (equal (distance (vlax-curve-getClosestPointTo TempObjName x) x ) 0 0.00001) x)) Pt_List))	(entdel TempObjName)		(setq Pt_List (append (vl-remove nil Pt_List) (list Pt1 Pt2)))		(setq Pt_List (BoxPoint Pt_List))	(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun ARC_Box(ObjName)	(setq 	P1 (cdr (assoc 10 Data)) 			Rd (* (abs Scale_X) (cdr (assoc 40 Data)))			EPs	(cdr(assoc 50 Data))			EPe	(cdr(assoc 51 Data)))									(setq EPs_org EPs EPe_org EPe)				(cond 	((and (< Scale_X 0)(> Scale_Y 0))(setq EPs (- pi EPe_org) 		EPe (- pi EPs_org)))		;X- Y+						((and (< 0 Scale_X)(< Scale_Y 0))(setq EPs (- (* 2 pi) EPe_org)	EPe (- (* 2 pi) EPs_org)))	;X+ Y-						((and (< Scale_X 0)(< Scale_Y 0))(setq EPs (+ pi EPs_org) 		EPe (+ pi EPe_org)))			;X- Y-				)								(setq EPs (+ EPs Ang))				(setq EPe (+ EPe Ang))	(setq EPs (- EPs (angle (trans '(0 0) 1 0)(trans  '(1 0) 1 0))))	(setq EPe (- EPe (angle (trans '(0 0) 1 0)(trans  '(1 0) 1 0))))	(setq Pt_List (list P1))	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))		(setq Data (subst (append  '(10) (car Pt_List)) (assoc 10 Data) Data))		(setq Data (subst (cons 50 EPs)(assoc 50 Data) Data))			(setq Data (subst (cons 51 EPe)(assoc 51 Data) Data))				(setq Data (subst (cons 40 Rd)(assoc 40 Data) Data))		(setq Data (subst (cons 8 "A51")(assoc 8 Data) Data))	(if (entmake Data)(setq TempObjName (entlast))(princ "\n Failed in ArcEntmake"))	(setq Pt1 (vlax-curve-getStartPoint TempObjName))			(setq Pt2 (vlax-curve-getEndPoint TempObjName))			(setq Pt_List (QuaterPt (car Pt_List) Rd))	(setq Pt_List (mapcar '(lambda(x)(if (equal (distance (vlax-curve-getClosestPointTo TempObjName x) x ) 0 0.00001) x)) Pt_List))	(entdel TempObjName)	(setq Pt_List (append (vl-remove nil Pt_List) (list Pt1 Pt2)))	(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List))	);;;===================================================(defun SPLINE_Box (ObjName)	(setq Pt_list (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 11)) Data)))	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y ))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun LWPOLYLINE_Box (ObjName)	(setq Pt_List (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 10)) Data)))		(setq R_List (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 42)) Data)))		(setq Flag401 (cdr(assoc 70 Data)))		(setq Drec (nth 3 (assoc 210 (entget ObjName))))	(setq Pt_List (MovRotScl Pt_List Ins_P Ang (* Drec Scale_X) Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))		(setq R_List (mapcar '(lambda(x)(*	(/ (* Scale_X Scale_Y)(abs (* Scale_X Scale_Y))) x)) R_List))		(setq Data (vl-remove-if '(lambda(x)(or (= (car x) 10)(= (car x) 40)(= (car x) 41)(= (car x) 42)(= (car x) 210))) Data))	(setq Data2 (apply 'append (mapcar '(lambda (x y) (list (append '(10) x)(cons 42 y))) Pt_List R_List)))	(setq Data (append Data Data2))	(setq Data (subst '(8 . "A51")(assoc 8 Data) Data))		(if (entmake Data)(setq TempObjName (entlast))(princ "\n Failed in LWPoly"))			(setq k 0 PtR_List nil)	(repeat (length Pt_List)		(if (/= (nth k R_List) 0)			(setq PtR_List 				(append PtR_List (list (list (nth k Pt_List)(if (null (nth (1+ k) Pt_List)) (nth 0 Pt_List)(nth (1+ k) Pt_List)) (nth k R_List))))))		(setq k (1+ k))	)	(if (= 0 Flag401)(setq PtR_List (reverse(cdr (reverse PtR_List)))))	(setq C_Rd_List (mapcar 'CompR PtR_List))		(setq QtPt_List (mapcar '(lambda(x) (QuaterPt (car x)(cadr x))) C_Rd_List))	(setq QtPt_List (mapcar '(lambda(y) (mapcar '(lambda(x)				(if (equal (distance (vlax-curve-getClosestPointTo TempObjName x) x) 0 0.00001) x )) y )) QtPt_List))	(entdel TempObjName)	(setq QtPt_List (vl-remove-if 'null (apply 'append QtPt_List)))		(setq Pt_List (append Pt_List QtPt_List))		_	(setq Pt_List (BoxPoint Pt_List))	(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun POLYLINE_Box (ObjName)	(setq ObjName (entnext ObjName) Pt_List nil)	(while	(/= (cdr(assoc 0 (entget ObjName))) "SEQEND")		(setq Pt_List (append Pt_List (list (cdr(assoc 10 (entget ObjName))))))		(setq ObjName (entnext ObjName))	)	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List))	);;;===================================================(defun MText_Box (ObjName)	(setq TBase (cdr (assoc 10 Data)))	(setq IP   (cdr (assoc 71 Data)))	(setq W_42     (cdr (assoc 42 Data)))	(setq H_43     (cdr (assoc 43 Data)))	(setq TAng     (+ (angle (trans '(0 0) 1 0)(trans  '(1 0) 1 0)) (cdr (assoc 50 Data))))			(setq Pt_List (list '(0 0) (list W_42 0) (list W_42 H_43) (list 0 H_43)))	(cond 	((= IP 1)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0 1.0)(nth 2 Pt_List)))) Pt_List)))			((= IP 2)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0.5 1.0)(nth 2 Pt_List)))) Pt_List)))			((= IP 3)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(1.0 1.0)(nth 2 Pt_List)))) Pt_List)))			((= IP 4)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0 0.5)(nth 2 Pt_List)))) Pt_List)))			((= IP 5)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0.5 0.5)(nth 2 Pt_List)))) Pt_List)))			((= IP 6)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(1.0 0.5)(nth 2 Pt_List)))) Pt_List)))			((= IP 7)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0 0)(nth 2 Pt_List)))) Pt_List)))			((= IP 8)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(0.5 0)(nth 2 Pt_List)))) Pt_List)))			((= IP 9)	(setq Pt_List (mapcar '(lambda(x)(mapcar '- x (mapcar '* '(1.0 0)(nth 2 Pt_List)))) Pt_List)))	)	(setq Pt_List (mapcar '(lambda(x)(SD8446  x '(0 0) TAng)) Pt_List))	(setq Pt_List (mapcar '(lambda(x) (mapcar '+  TBase x)) Pt_List))	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun Text_Box (ObjName)	(setq TBase (cdr (assoc 10 Data)))			(setq Pt2 (cadr (textbox Data)))				(setq TAng (cdr (assoc 50 Data)))			(setq Pt_List (list '(0 0) (list (car Pt2) 0) Pt2 (list 0 (cadr Pt2))))	(setq Pt_List (mapcar '(lambda(x)(SD8446  x '(0 0) TAng)) Pt_List))	(setq Pt_List (mapcar '(lambda(x) (mapcar '+  TBase x)) Pt_List))		(if (null AttribFlag)(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y)))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (BoxPoint Pt_List))	(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun Line_Box (ObjName);	(princ "\n Line_Box--------------------------")		(setq Pt_List (list (cdr (assoc 10 Data))(cdr (assoc 11 Data))))	(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))		(setq Pt_List (BoxPoint Pt_List))		(setq Pt_List_M (append Pt_List_M Pt_List))	Pt_List_M);;;===================================================(defun CIRCLE_Box(ObjName);	(princ "\n CIRCLE_Box--------------------------")	(setq 	P1 (cdr (assoc 10 Data)) 			Rd (* (abs Scale_X) (cdr (assoc 40 Data))))		(setq Pt_List (list P1))		(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List (list (mapcar '- (car Pt_List)(list Rd Rd))(mapcar '+ (car Pt_List) (list Rd Rd) )))	(setq Pt_List_M (append Pt_List_M Pt_List)));;;===================================================(defun POINT_Box(ObjName)	(setq 	P1 (cdr (assoc 10 Data)))		(setq Pt_List (list P1))		(setq Pt_List (MovRotScl Pt_List Ins_P Ang Scale_X Scale_Y))	(setq Pt_List (mapcar '(lambda(x)(trans x 0 1)) Pt_List))	(setq Pt_List_M (append Pt_List_M Pt_List)))(defun QuaterPt (Pt Rd / )			(setq Px (car Pt) Py (cadr Pt))	(setq QtPt_List (list	(list Px (- Py Rd))	(list (+ Px Rd) Py)	(list Px (+ Py Rd))	(list (- Px Rd) Py)))		;4•ª‰~"_	QtPt_List		j)(defun CompR (PtR_List /)	(setq P1X (caar PtR_List)) 			(setq P1Y (cadar PtR_List))			(setq P2X (caadr PtR_List))			(setq P2Y (cadadr PtR_List))			(setq Ratio (nth 2 PtR_List))	(setq Dist (distance (car PtR_List) (cadr PtR_List)))	(setq Rd (abs ( / (* Dist (+ 1 (expt Ratio 2))) (* 4 Ratio))))	(setq POX ( + ( * (+ P1X P2X) 0.5) ( / ( * (- (expt Ratio 2) 1) (- P2Y P1Y)) ( * 4 Ratio))))	(setq POY ( - ( * (+ P1Y P2Y) 0.5) ( / ( * (- (expt Ratio 2) 1) (- P2X P1X)) ( * 4 Ratio))))	(setq C_Rd (list (list POX POY) Rd))	C_Rd		)(defun AngleCircleToEllip ( AngOnCircle Rate)		(setq AngOnEllip (atan (/ (sin AngOnCircle) (* Rate (cos AngOnCircle)))))	(cond 	((and (<= (* -2.0 pi) AngOnCircle)(< AngOnCircle (* -1.5 pi)))(setq  AngOnEllip (- AngOnEllip (* 2.0 pi))))			((and (<= (* -1.5 pi) AngOnCircle) (< AngOnCircle (* -0.5 pi)))	(setq  AngOnEllip (- AngOnEllip pi)))			((and (<= (* 0.5 pi) AngOnCircle) (< AngOnCircle (* 1.5 pi)))	(setq  AngOnEllip (+ pi AngOnEllip)))			((and (<= (* 1.5 pi) AngOnCircle) (< AngOnCircle (* 2.0 pi)))	(setq  AngOnEllip (+ (* 2.0 pi) AngOnEllip))))	AngOnEllip)(defun BoxPoint (Pt_List / V1 V2 )	(setq V1 (list (apply 'min (mapcar 'car Pt_List))(apply 'min (mapcar 'cadr Pt_List))))	(setq V2 (list (apply 'max (mapcar 'car Pt_List))(apply 'max (mapcar 'cadr Pt_List))))	(setq Pt_List (list V1 V2)))(defun MakeList_PLine ()	(setq mm (1+ mm))	(while (and (/= (car (nth mm Data)) 92)(/= (car (nth mm Data)) 97)(/= (car (nth mm Data)) 75))		(cond 	((= (car (nth mm Data)) 93)(setq PL_NoPt_Temp (append PL_NoPt_Temp (list (cdr (nth mm Data))))))	;'¸"_"				((= (car (nth mm Data)) 10)(setq PL_Pt_Temp (append PL_Pt_Temp (list (cdr (nth mm Data))))))	;'["_				((= (car (nth mm Data)) 42)(setq PL_R_Temp (append PL_R_Temp (list (cdr (nth mm Data))))))	;‚Ó‚­‚ç‚Ý		)		(setq mm (1+ mm))	)	(setq mm (- mm 1))		(if 	(null PL_R_Temp)		(setq L_Line0 PL_Pt_Temp PL_NoPt_Temp nil PL_Pt_Temp nil ))		(setq PL_NoPt (append PL_NoPt PL_NoPt_Temp))	(setq PL_Pt (append PL_Pt PL_Pt_Temp))	(setq PL_R (append PL_R PL_R_Temp))	(setq L_Line (append L_Line L_Line0))	)(defun MakeList_Line ( / L_Line0)	(setq mm (1+ mm))	(while (and (/= (car (nth mm Data)) 72)(/= (car (nth mm Data)) 92)				(/= (car (nth mm Data)) 97)(/= (car (nth mm Data)) 75))		(setq L_Line0 (append L_Line0 (list (cdr (nth mm Data)))))		(setq mm (1+ mm))	)	(setq mm (- mm 1))	(setq L_Line (append L_Line L_Line0))	)(defun MakeList_Arc ( / L_Arc0)	(setq mm (1+ mm))	(while (and (/= (car (nth mm Data)) 72)(/= (car (nth mm Data)) 92)				(/= (car (nth mm Data)) 97)(/= (car (nth mm Data)) 75))		(setq L_Arc0 (append L_Arc0 (list (cdr (nth mm Data)))))		(setq mm (1+ mm))	)	(setq mm (- mm 1))	(setq L_Arc (append L_Arc (list L_Arc0))))(defun MakeList_Ellip ( / L_Ellip0)	(setq mm (1+ mm))	(while (and (/= (car (nth mm Data)) 72)(/= (car (nth mm Data)) 92)				(/= (car (nth mm Data)) 97)(/= (car (nth mm Data)) 75))		(setq L_Ellip0 (append L_Ellip0 (list (cdr (nth mm Data)))))		(setq mm (1+ mm))	)	(setq mm (- mm 1))	(setq L_Ellip (append L_Ellip (list L_Ellip0))))(defun MakeList_Spline ( /L_Spline0)	(setq mm (1+ mm))	(while (and (/= (car (nth mm Data)) 72)(/= (car (nth mm Data)) 92)				(/= (car (nth mm Data)) 97)(/= (car (nth mm Data)) 75))		(if (= (car (nth mm Data)) 10)			(setq L_Spline0 (append L_Spline0 (list (cdr (nth mm Data))))))		(setq mm (1+ mm))	)	(setq mm (- mm 1))	(setq L_Spline (append L_Spline (list L_Spline0))))(defun Entmod_Obj_401 (ObjName	DeltaPt /  NewData Flag3 NextName Loc DataA NextObjType Flag4 Flag5)	(setq Data (entget ObjName))	(setq ObjType (cdr(assoc 0 Data)))	(cond 	((or (= ObjType "LINE")	(= ObjType "SPLINE"))				(entmod (mapcar '(lambda(x)(if 	(or (= (car x) 10) (= (car x) 11))														(list (car x)(+ (nth 1 x) (car DeltaPt))(+ (nth 2 x)(cadr DeltaPt))(nth 3 x))														x)) (entget ObjName)))			)			((= ObjType "INSERT")				(setq Loc (assoc 10 Data))				(entmod (subst 	(list 10 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))	Loc Data))								(cond 	((= (cdr (assoc 66 Data)) 1)						(setq ObjNext (entnext ObjName))						(while 	(= (cdr (assoc 0 (setq DataA (entget ObjNext)))) "ATTRIB")						       	(setq Loc (assoc 11 DataA))						       	(entmod(subst 	(list 11 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))	Loc DataA))								(entupd ObjNext)								(setq ObjNext(entnext ObjNext))						)						)				)			)			((= ObjType "POLYLINE")				;vertex				(setq NextName (entnext ObjName))				(setq NextObjType (cdr (assoc 0  (entget NextName))))				(while (/= NextObjType "SEQEND")					(if (= (cdr(assoc 0 (setq DataA (entget NextName)))) "VERTEX")			            	(progn	(setq Loc (assoc 10 DataA))			            			(entmod (subst 	(list 10 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))	Loc DataA))			            			(entupd NextName)			            	)			            )					(setq NextName(entnext NextName))					(setq NextObjType (cdr (assoc 0  (entget NextName))))				)			)			((= ObjType "HATCH")				(entmod (mapcar '(lambda(x)					(cond	((and (= (car x) 92)(= (logand (cdr x) 2) 2))								(setq Flag4 nil Flag5 nil)							)							((and (= (car x) 92)(/= (logand (cdr x) 2) 2))								(setq Flag4 T Flag5 nil)							)					)					(cond	((and (= (car x) 72)(= (cdr x) 3) Flag4)								(setq Flag5 T)													)							((and (= (car x) 72)(/= (cdr x) 3) Flag4)							(setq Flag5 nil)													)						)					(cond 	((and Flag5 (=(car x) 10))								(list 10 (+ (nth 1 x) (car DeltaPt))(+ (nth 2 x)(cadr DeltaPt))(nth 3 x))													)							((and (null Flag5)(or (=(car x) 10)(=(car x) 11)))								(list (car x) (+ (nth 1 x) (car DeltaPt))(+ (nth 2 x)(cadr DeltaPt))(nth 3 x))													)							(T x)					)					)Data)				)			)			((= ObjType "LWPOLYLINE")				(if (<= 0 (nth 3 (assoc 210 (entget ObjName))))(setq Flag3 1)(setq Flag3 -1))				(entmod (mapcar '(lambda(x) (if (= (car x) 10)(list 10 (+ (nth 1 x)(* Flag3 (car DeltaPt)))(+ (nth 2 x)(cadr DeltaPt))) x))											(entget ObjName)))     	     )	       	((= ObjType "DIMENSION")				(entmod (mapcar '(lambda(x)(if 	(or (= (car x) 10) (= (car x) 11)(= (car x) 13)(= (car x) 14)(= (car x) 15))														(list (car x)(+ (nth 1 x) (car DeltaPt))(+ (nth 2 x)(cadr DeltaPt))(nth 3 x))														x)) (entget ObjName)))	            )			((= ObjType "TEXT")		            (if 	(and (= (cdr(assoc 72 (entget ObjName))) 0)(= (cdr(assoc 73 (entget ObjName))) 0))		            	(progn	(setq Loc (assoc 10 Data))		            			(entmod (subst 	(list 10 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))	Loc Data))		            	)		            	(progn	(setq Loc (assoc 11 Data))		            			(entmod (subst 	(list 11 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))	Loc Data))		            	)			     )	            )	       	((or (= ObjType "CIRCLE")(= ObjType "ARC")(= ObjType "ELLIPSE")(= ObjType "MTEXT")(= ObjType "ATTDEF"))		       	(setq Loc (assoc 10 Data))		       	(entmod (subst 	(list 10 (+ (nth 1 Loc) (car DeltaPt))(+ (nth 2 Loc)(cadr DeltaPt))(nth 3 Loc))		       					Loc Data))		       )     		(T	(princ "\n Not Defined"))     ))(princ)(defun SD8446 ( PointA PointB Ang / XA YA XB YB PointC)	(setq	XA2(- (car PointA) (car PointB))			YA2(- (cadr PointA) (cadr PointB))	)	(setq PointC (list (- (* XA2 (cos Ang))(* YA2 (sin Ang))) (+ (* XA2 (sin Ang))(* YA2 (cos Ang)))))	(setq PointC (mapcar '+ PointC PointB))	PointC)(defun MovRotScl (Pt_List Ins_P Ang Scale_X Scale_Y / )	(setq Pt_List (mapcar '(lambda(x)(mapcar '* (list Scale_X Scale_Y ) x )) Pt_List))		;scale	(setq Pt_List (mapcar '(lambda (x) (list     (- (* (cos Ang) (car x)) (* (sin Ang) (cadr x))) (+ (* (sin Ang) (car x)) (* (cos Ang) (cadr x))))) Pt_List))	(setq Pt_List (mapcar '(lambda(x)(mapcar '+ Ins_P x)) Pt_List)) 	;move	Pt_List)(defun MakeListInsideBlock ( ObjName1 / B_Name1 I_ObjName1 I_ObjType1 I_ObjList1)	(setq B_Name1 (cdr (assoc 2 (entget ObjName1))))	(setq I_ObjName1 (cdr(assoc -2(tblsearch "block" B_Name1))))	(setq I_NameList1 (list I_ObjName1))	(while	(entnext I_ObjName1)		(setq I_ObjName1 (entnext I_ObjName1))		(setq I_NameList1 (append I_NameList1 (list I_ObjName1)))	)	I_NameList1)(defun GetObjSize_401 ( ObjName / Ins_P Ang Scale_X Scale_Y Data  I_NameList Pt_List_M									L_Line L_Arc L_Ellip L_Spline  PL_NoPt PL_Pt PL_R									nn mm Item j p Pt_List C_Rd_List QtPt_List 									P1 P2 P2x P2y Rate EPs EPe	EDrec Pt_List2 Pt_List3									PL_NoPt_Temp PL_Pt_Temp PL_R_Temp L_Line0 L_Arc0 L_Ellip0 L_Spline0)	(setq Ins_P '(0 0) Ang 0.0 Scale_X 1.0 Scale_Y 1.0)	(setq Pt_List_M (Distribution_401 ObjName))	Pt_List_M)

E cũng làm 1 phát test với 40k đối tượng già trẻ lớn bé to nhỏ đậm nhạt..Kết quả có phần đạt yêu cầu ^^

 

Cái này mà bác ketxu thêm chức năng giãn dòng nữa thì rất ok. 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

Nhờ Bác Ketxu chỉnh sửa hộ lisp trên để căn text, mtext, pline, bock như hình vẽ (lấy tim căn là đường line hoặc pline màu xanh) Cám ơn Bác

 

http://www.cadviet.c..._drawing1_1.dwg

 

Phải chăng bạn muốn xếp các block lên đường pline đúng vị trí tương ứng của các cụm đánh số thứ tư và đặt các cụm này cách pline một khoảng nhất định do bạn chọn.

Nếu dúng vậy thì có thể không cần chờ bác ketxu đâ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

Vâng Cám ơn Bác Bình. Hiện tại các Block của em linh tinh quá em muồn di chuyển xắp xếp vào đường line và các text, line cột TT tương ứng theo 1 khoảng cách đặt ra 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

Vâng Cám ơn Bác Bình. Hiện tại các Block của em linh tinh quá em muồn di chuyển xắp xếp vào đường line và các text, line cột TT tương ứng theo 1 khoảng cách đặt ra Bác ạ.

Hề hề hề,

Lisp đã viết xong, nhưng diễn đàn trục trặc chi đó mà cả ngày hôm qua không post lên được. Tuy nhiên có một vài vấn đề cần lưu ý với bạn khi sử dụng như sau:

1/- Bản vẽ bạn gửi có rất nhiều đối tượng trùng nhau. Điều này gây khó khăn cho lisp khiến nó không chạy tốt được. Bạn nên sử dụng lệnh overkill trong express d963 loại hết các đối tượng trùng nhau trước khi chạy lisp.

2/- các line mặt đất của bạn vẽ nhiều chỗ không chuẩn , Đít thằng nọ không ngồi lên đầu thằng kia. Vì thế việc chuyển đổi từ line về pline bị trục trặc. bạn cần kiểm soát lại toàn bộ các line mặt đất để đảm bảo đít thằng nọ ngồi đúng đầu thằng kia mới được.

3/- Các block bạn đã nhét sẵn vào bản vẽ hoàn toàn không cần dùng đến nó vì khi chạy lisp sẽ chèn các block mới vào điểm cần chèn. Như vậy xem ra hợp lý hơn là việc move các block có sẵn về điểm chèn mới. (vì chả biết nên move thằng nào)

4/- Bạn nên làm việc dọn dẹp bản vẽ thường xuyên để tránh tình trạng như bản vẽ bạn đã gửi. Nó gây khó khăn rất nhiều cho người làm lisp không am hiểu chuyên ngành của bạn như mình.

 

Đây là lisp. Bạn hãy làm đúng như mình nói rồi hẵng test, nếu không bạn sẽ thất vọng đó.

 


(defun c:sxtc ( / oldos p1 p2 ss ssl ss1 ssl1 h p0 sst pc )
(vl-load-com)
(setq oldos (getvar "osmode") )
(setvar "osmode" 0)
(alert "\n Chuyen cac line mat dat thanh polyline")
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem goc tren ben trai vung chon"))
(setq p2 (getpoint p1 "\n Chon diem goc duoi ben phai vung chon"))

(setq ssl (acet-ss-to-list (setq ss (ssget "c" p1 p2 (list (cons 0 "*line") (cons 8 "_MatDat") (cons 62 5))))))
(while (and ss (> (sslength ss) 1))
(setq pl (nth 0 ssl))
(if (= (cdr (assoc 0 (entget pl))) "LINE")
   (command "pedit" pl "y" "j" ss "" "")
   (command "pedit" pl "j" ss "" "")
)
(setq ssl (acet-ss-to-list (setq ss (ssget "c" p1 p2 (list (cons 0 "*line") (cons 8 "_MatDat") (cons 62 5))))))
)

(setq h (getreal "\n Nhap khoang cach tu line toi pline: "))
(setq plo (vlax-ename->vla-object (entlast)))
(setq ssl1 (acet-ss-to-list (ssget "c" p1 p2 (list (cons 0 "line") (cons 8 "025") (cons 62 7)))))
(foreach lin ssl1
   (setq p0 (mid (cdr (assoc 10 (entget lin))) (cdr (assoc 11 (entget lin)))) )
   (setq sst (acet-ss-to-list (setq ss1 (ssget "w" (list (- (car p0) 45) (- (cadr p0) 45)) (list (+ (car p0) 45) (+ (cadr p0) 45)) 
                                                               (list (cons 0 "text") (cons 8 "025")))))  )
   (foreach txt sst
           (setq pt (cdr (assoc 11 (setq enl (entget txt)))))
           (if (> (cadr pt) (cadr p0))
               (entmod (subst (cons 11 (list (car p0) (+ (cadr p0) 12.5))) (assoc 11 enl) enl))
               (entmod (subst (cons 11 (list (car p0) (- (cadr p0) 12.5))) (assoc 11 enl) enl))
           )
   )
   (setq pc (vlax-curve-getClosestPointToProjection plo p0 (list 0 1 0) )  )
   (command "insert" "Coc" pc 1 1 0)
   (command "move" lin ss1 "" p0 (list (car pc) (+ (cadr pc) h))  )
) 
(command "explode" (vlax-vla-object->ename plo))               
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mid (p1 p2)
(setq p (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)))  
)

Chúc bạn vui.

  • 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

Cám ơn Bác Bình đã viết giúp lisp trên .Nhưng nó sảy ra 3 vấn đề :

+ Các Bock và các text của em sảy ra trường hợp có lúc nằm bên trên, có lúc nằm bên dưới và có lúc nằm trùng với đường line.Năm bên trên thì lisp của bác chạy rất tốt còn nằm bên dưới và trùng với đường line thì không chạy được.

+ Đường mặt đất có thể là đường line hoặc đường Pline.

+ Khi chạy lisp của Bác thì block cot chỉ copy xuống đường line mặt đất chứ không phải di chuyển.

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 Bác Bình đã viết giúp lisp trên .Nhưng nó sảy ra 3 vấn đề :

+ Các Bock và các text của em sảy ra trường hợp có lúc nằm bên trên, có lúc nằm bên dưới và có lúc nằm trùng với đường line.Năm bên trên thì lisp của bác chạy rất tốt còn nằm bên dưới và trùng với đường line thì không chạy được.

+ Đường mặt đất có thể là đường line hoặc đường Pline.

+ Khi chạy lisp của Bác thì block cot chỉ copy xuống đường line mặt đất chứ không phải di chuyển.

Hề hề hề,

Tại bạn không đọc kỹ hướng dẫn trước khi sử dụng lisp đó thôi.

1/- Các cụm text và line nằm đâu cũng vậy, miễn là nó nằm tương ứng với vị trí của nó trên đường mặt đất. Sau khi chạy lisp xong thì tất cả đều nằm các đường mặt đất một khoảng như nhau, trên hay dưới hay trùng tùy theo bạn nhập giá trị này.

2/- Các đường mặt đất của bạn có thể là pline nhưng với điều kiện các pline này phải nối tiếp nhau và không có đoạn nào trùng nhau.

3/- Các block cũ của bạn nê xóa sạch trước khi chạy lisp vì lý do mình đã nói ở bài trước.

Hề hề hề, hãy đọc kỹ hướng dẫn sử dụng trước khi dùng.

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

http://www.cadviet.com/upfiles/3/77310_vi_du.rar Nhờ các bác Bình và các Bác trên diễn đàn xem hộ em Lisp này

Em có nhờ anh bạn em viết hộ lisp nhưng lisp có nhược điểm khi chạy lisp này chọn tất cả các block thì Block chỉ di chuyển về được line màu xanh được một vài block mà không di chuyển được tất cả các block về tim tuyến khi kết thúc lệnh.

Hơn nữa do bạn em trình độ có hạn không viết được đoạn lisp di chuyển cả cụm text bên trên cách đường xanh 1 khoảng cách như lisp của bác Bình.

Nhờ các Bác chỉnh sửa giùm em nhé. Cám ơn các Bác

 

 

 

(defun giaodiem (a1 b1 c1)

(setq x (cadr a1)

y (+ (/ (* (- x (cadr b1)) (- (caddr c1) (caddr b1))) (- (cadr c1) (cadr b1))) (caddr b1))

)

(list 10 x y (cadddr a1))

)

;***************************************************************

(defun C:Mm()

(prompt "\nChon doi tuong di chuyen:")

(setq ss (ssget)

Q (sslength ss)

)

(setq pp (ssget "X" '((0 . "LINE") (62 . 5)))

P (sslength pp)

)

(setq i 0 j 0)

(while (< i (* Q 50))

(setq A (entget (ssname ss i)))

(setq B (entget (ssname pp j)))

(setq L10 (assoc 10 A)

L11 (assoc 10 B)

M11 (assoc 11 B)

)

 

(if (and (>= (cadr L10) (cadr L11)) (<= (cadr L10) (cadr M11)))

(progn

(setq D10 (giaodiem L10 L11 M11)

A (subst D10 L10 A)

)

)

(setq j (+ j 1) i (- i 1))

 

)

(setq i (+ i 1))

(entmod A)

)

(princ)

)

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

http://www.cadviet.c...77310_vi_du.rar Nhờ các bác Bình và các Bác trên diễn đàn xem hộ em Lisp này

Em có nhờ anh bạn em viết hộ lisp nhưng lisp có nhược điểm khi chạy lisp này chọn tất cả các block thì Block chỉ di chuyển về được line màu xanh được một vài block mà không di chuyển được tất cả các block về tim tuyến khi kết thúc lệnh.

Hơn nữa do bạn em trình độ có hạn không viết được đoạn lisp di chuyển cả cụm text bên trên cách đường xanh 1 khoảng cách như lisp của bác Bình.

Nhờ các Bác chỉnh sửa giùm em nhé. Cám ơn các Bác

 

 

 

(defun giaodiem (a1 b1 c1)

(setq x (cadr a1)

y (+ (/ (* (- x (cadr b1)) (- (caddr c1) (caddr b1))) (- (cadr c1) (cadr b1))) (caddr b1))

)

(list 10 x y (cadddr a1))

)

;***************************************************************

(defun C:Mm()

(prompt "\nChon doi tuong di chuyen:")

(setq ss (ssget)

Q (sslength ss)

)

(setq pp (ssget "X" '((0 . "LINE") (62 . 5)))

P (sslength pp)

)

(setq i 0 j 0)

(while (< i (* Q 50))

(setq A (entget (ssname ss i)))

(setq B (entget (ssname pp j)))

(setq L10 (assoc 10 A)

L11 (assoc 10 B)

M11 (assoc 11 B)

)

 

(if (and (>= (cadr L10) (cadr L11)) (<= (cadr L10) (cadr M11)))

(progn

(setq D10 (giaodiem L10 L11 M11)

A (subst D10 L10 A)

)

)

(setq j (+ j 1) i (- i 1))

 

)

(setq i (+ i 1))

(entmod A)

)

(princ)

)

Hề hề hề,

Về ý tưởng thì người viết lisp này không hề có ý định di chuyển các cụm text và line, chỉ di chuyển các block mà thôi. Tuy nhiên nếu người sử dụng quét chọn cả text và line thì nó cũng sẽ bị di chuyển mà không đúng với ý định của người dùng.

Việc lisp không di chuyển được tất cả các block được chọn có nhẽ do người viết lisp tạo vòng lặp While chưa tốt.

Để có thể di chuyển được hết các block bạn thử sửa lại như sau;

1/- Chép thêm một dòng code (while (< j P) vào phía dưới dòng code (while (< i (* Q 50))

2/- Chép thêm một ngoặc đóng vào trước dòng code (setq i (+ i 1 ))

3/- Xóa bỏ đoạn code i (- i 1) trong dòng (setq j (+ j 1) i (- i 1))

 

Sau đó bạn hãy test lại xem nó đã chuyển hết các đối tượng block được chọn hay chưa nhé.

Chúc bạn vui.

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

Không được đâu bác Bình ơi Em chạy rồi mà không di chuyển được block nào. Bác kiểm tra lại giúp em với nhé.

Tiện thể Bác thêm code di chuyển cụm text có 1 khoảng cách khi quét chọn cả text và line giống như code hôm trước Bác đã giúp em.

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


×