Chuyển đến nội dung
Diễn đàn CADViet
ketxu

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

Bởi ketxu , trong AutoLisp

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

ketxu    2.983

ketxu
Đã đăng

Trước giờ, e vẫn dùng lisp ft của bác Đường Thái để căn lề cho text, cảm thấy rất ưng ý rồi, cứ ngỡ rằng như thế là đủ...Vừa rồi lớ ngớ mò vào trang Nhật Bổn, mót được cái này,e liền làm thử bài đánh giá, thấy tốc độ khá tốt, các bác thử chém gió xem sao, và vì code dài nên e cũng chẳng hiểu tại sao ^^

 

Mạn phép bác Thái,E xin post lại lisp ft của bác, thêm dòng check time :

 

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]"))) (canle)))
(setq oldang (getvar "Angbase"))
(command "angbase" 0 "ucs" "w")

(setq time (getvar "MILLISECS"))

(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" 0 txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "angbase" oldang)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")

(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))

(prompt"\nText da duoc sap xep lai\n")
(command "undo" "end")
);defun

 

Bên dưới là code khác,dài hơn,cũng với chức năng tương tự (và đổi Insert point của text) :


(defun c:trai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Left and align to Left")					
(setq Value72_73_71  '(0 0 7))
(setq AssocL '(10 10))
(Procedure)
(princ)
)

(defun c:giua ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Center and align to Center")							
(setq Value72_73_71 '(1 0 8))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

(defun c:phai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)
(princ "\n Change Insetion point to Right and align to Right")							

(setq Value72_73_71 '(2 0 9))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

;***************************************************
(defun Procedure ()
(while (= ObjSet nil)
	(setq ObjSet (ssget '((-4 . ""))))
)
(setq ObjName0 (car (entsel "\n")))	
(setq i 0)
(setq time (getvar "MILLISECS"))
(repeat (sslength ObjSet)
	(setq ObjName (ssname ObjSet i))
	(setq Data (entget	ObjName))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")
				(TextInsP_Text ObjName Value72_73_71)	
				(setq Co (car AssocL))
			)
			(	(= (cdr(assoc 0 Data)) "MTEXT")		
				(TextInsP_MText ObjName Value72_73_71)	
				(setq Co (cadr AssocL))
			)
	)
	(setq i (1+ i))
)


(setq Data0 (entget ObjName0))
(setq Ang1 (angle '(0 0) (getvar "UCSXDIR")))
(cond 	((= (cdr(assoc 0 Data0)) "TEXT")
		(setq AngT (cdr(assoc 50 Data0)))				
		(setq Ang2 (- AngT Ang1))					
		(setq Co (car AssocL))
		)
		((= (cdr(assoc 0 Data0)) "MTEXT")
		(setq Ang2 (cdr(assoc 50 Data0)))			
		(setq AngT (+ Ang1 Ang2))					
		(setq Co (cadr AssocL))
		)
)
(setq Pt0 (cdr (assoc Co Data0)))		
(setq Pt0_U (trans Pt0 0 1))			
(setq Pt0_O (SD1862 Pt0_U Ang2))	

(setq i 0)
(repeat (sslength ObjSet)
	(setq Data (entget (setq ObjName (ssname ObjSet i))))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")(setq Co (car AssocL)))
			((= (cdr(assoc 0 Data)) "MTEXT")(setq Co (cadr AssocL)))
	)
	(setq Pt1 (cdr (assoc Co Data)))				
	(setq Pt1_U (trans Pt1 0 1))				
	(setq Pt1_O (SD1862 Pt1_U Ang2))		
	(setq Delta_O (- (car Pt0_O) (car Pt1_O)))		
	(setq Delta_U (SD8446 (list Delta_O 0) '(0 0) AngT))	
	(setq Data (subst (cons Co (mapcar '+ Pt1 Delta_U))(assoc Co Data) Data))		
	(entmod Data)
	(setq i (1+ i))
)
(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))	
(princ)
)



(defun TextInsP_Text ( ObjName Value72_73_71 / Data OrgPosition NewPosition Org_11 New_11 )

	(setq Data (entget	ObjName))				
	(setq OrgPosition (cdr (assoc 10 Data)))		
	(setq Org_11 (cdr (assoc 11 Data)))			,0,0j
	(setq Data (subst (cons 72 (car Value72_73_71)) (assoc 72 Data) Data))
	(setq Data (subst (cons 73 (cadr Value72_73_71)) (assoc 73 Data) Data))
	(entmod Data)

	(setq NewPosition (cdr (assoc 10 (entget  ObjName))))	
	(setq Delta (mapcar '- OrgPosition NewPosition))				
	(setq New_11 (mapcar '+ Org_11 Delta))		
	(setq Data (entget	ObjName))					
	(setq Data (subst (cons 11 New_11) (assoc 11 Data)	Data))	
	(entmod Data)
)


(defun TextInsP_MText ( ObjName Value72_73_71 / Data X_Old X_New Y_Old Y_New Scale Base0 W_42 Ang_50 Delta )
	(setq Data (entget	ObjName))
	(setq InsP (cdr (assoc 10 Data)))
	(setq W_42	(cdr (assoc 42 (entget ObjName))))
	(setq H_43	 	(cdr (assoc 43 (entget ObjName))))
	(setq Ang (cdr (assoc 50 Data)))		
	(setq AngU (angle '(0 0) (getvar "UCSXDIR")))	
	(setq OldIP (cdr (assoc 71 Data)))			
	(setq NewIP (caddr Value72_73_71))		

	(setq Data (subst (cons 71 NewIP) (assoc 71 Data) Data))
	(entmod Data)


	(setq X_Old (- (+ OldIP 2) (* (fix ( / (+ OldIP 2) 3)) 3)))
	(setq X_New (- (+ NewIP 2) (* (fix ( / (+ NewIP 2) 3)) 3)))


	(setq Y_Old (fix ( / (- OldIP 1) 3)))
	(setq Y_New (fix ( / (- NewIP 1) 3)))

	(setq IncUnit (list (- X_New X_Old)(- Y_Old Y_New )))



	(setq Delta (mapcar '* IncUnit (list (* 0.5 W_42)(* 0.5 H_43))))

	(setq Delta (SD8446 Delta '(0 0) Ang))

·
	(setq Delta (SD1862 Delta (* -1.0 AngU)))

	(setq Data (subst (cons 10 (mapcar '+ InsP Delta))(assoc 10 Data) Data))
	(entmod Data)

)

(defun SD1862 (OldPt Ang / NewCs)
(setq NewCs (SD8446 '(1 0) '(0 0) Ang))
(setq NewPt (trans OldPt 0 NewCs))
(setq NewPt (list (nth 2 NewPt)(nth 0 NewPt)))
NewPt
)

(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
)

 

Tiếp theo, thực hiện test so sánh :

Lần 1: với 100 text và sắp xếp bên trái :

Command: ft

 

Select objects: Specify opposite corner: 100 found

 

Select objects:

Chon text chuanVi tri can le [Left/Center/Right/Fit/]L

 

Thoi gian thuc hien (giay) :6.053

Text da duoc sap xep lai

nil

Command: trai

 

Change Insetion point to Left and align to Left100 found

 

 

Thoi gian thuc hien (giay) :0.171

-> gần như là ngay tức thì

 

Lần 2, e chơi sang làm hẳn 1000 text + Mtext đi .Lần này thì :

Command: ft

 

Select objects: Specify opposite corner: 77 found

.......

Select objects: Specify opposite corner: 279 found (279 duplicate), 1000 total

 

Select objects:

Chon text chuanVi tri can le [Left/Center/Right/Fit/]L

 

Thoi gian thuc hien (giay) :64.413

Text da duoc sap xep lai

nil

Command: Specify opposite corner:

Command: trai

 

Change Insetion point to Left and align to Left1000 found

 

 

Thoi gian thuc hien (giay) :1.388

- > :undecided:

 

Vậy là tương quan,2 lisp chênh nhau về thời gian xử lý khoảng 50 lần.Tất nhiên, ngoài thực tế ít khi ta gặp 1 đoạn văn bản CAD dài như vậy, nhưng nhiều khi, 1 vấn đề đã cũ,mà vẫn có nhiều lựa chọn giải quyết.

 

PS :Còn đoạn code FIT + code sắp xếp Đối tượng cũng khù khoằm như vậy,tí rỗi e post típ ^^

 

P/S 2 : hình như 4room lại trục trặc, e post file lisp đây

Lisp

  • Vote tăng 5

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

thanhduan2407    272

thanhduan2407
Đã đăng
Trước giờ, e vẫn dùng lisp ft của bác Đường Thái để căn lề cho text, cảm thấy rất ưng ý rồi, cứ ngỡ rằng như thế là đủ...Vừa rồi lớ ngớ mò vào trang Nhật Bổn, mót được cái này,e liền làm thử bài đánh giá, thấy tốc độ khá tốt, các bác thử chém gió xem sao, và vì code dài nên e cũng chẳng hiểu tại sao ^^

 

Mạn phép bác Thái,E xin post lại lisp ft của bác, thêm dòng check time :

 

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(setq oldang (getvar "Angbase"))
(command "angbase" 0 "ucs" "w")

(setq time (getvar "MILLISECS"))

(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" 0 txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "angbase" oldang)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")

(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))

(prompt"\nText da duoc sap xep lai\n")
(command "undo" "end")
);defun

 

Bên dưới là code khác,dài hơn,cũng với chức năng tương tự (và đổi Insert point của text) :


(defun c:trai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Left and align to Left")					
(setq Value72_73_71  '(0 0 7))
(setq AssocL '(10 10))
(Procedure)
(princ)
)

(defun c:giua ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Center and align to Center")							
(setq Value72_73_71 '(1 0 8))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

(defun c:phai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)
(princ "\n Change Insetion point to Right and align to Right")							

(setq Value72_73_71 '(2 0 9))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

;***************************************************
(defun Procedure ()
(while (= ObjSet nil)
	(setq ObjSet (ssget '((-4 . ""))))
)
(setq ObjName0 (car (entsel "\n")))	
(setq i 0)
(setq time (getvar "MILLISECS"))
(repeat (sslength ObjSet)
	(setq ObjName (ssname ObjSet i))
	(setq Data (entget	ObjName))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")
				(TextInsP_Text ObjName Value72_73_71)	
				(setq Co (car AssocL))
			)
			(	(= (cdr(assoc 0 Data)) "MTEXT")		
				(TextInsP_MText ObjName Value72_73_71)	
				(setq Co (cadr AssocL))
			)
	)
	(setq i (1+ i))
)


(setq Data0 (entget ObjName0))
(setq Ang1 (angle '(0 0) (getvar "UCSXDIR")))
(cond 	((= (cdr(assoc 0 Data0)) "TEXT")
		(setq AngT (cdr(assoc 50 Data0)))				
		(setq Ang2 (- AngT Ang1))					
		(setq Co (car AssocL))
		)
		((= (cdr(assoc 0 Data0)) "MTEXT")
		(setq Ang2 (cdr(assoc 50 Data0)))			
		(setq AngT (+ Ang1 Ang2))					
		(setq Co (cadr AssocL))
		)
)
(setq Pt0 (cdr (assoc Co Data0)))		
(setq Pt0_U (trans Pt0 0 1))			
(setq Pt0_O (SD1862 Pt0_U Ang2))	

(setq i 0)
(repeat (sslength ObjSet)
	(setq Data (entget (setq ObjName (ssname ObjSet i))))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")(setq Co (car AssocL)))
			((= (cdr(assoc 0 Data)) "MTEXT")(setq Co (cadr AssocL)))
	)
	(setq Pt1 (cdr (assoc Co Data)))				
	(setq Pt1_U (trans Pt1 0 1))				
	(setq Pt1_O (SD1862 Pt1_U Ang2))		
	(setq Delta_O (- (car Pt0_O) (car Pt1_O)))		
	(setq Delta_U (SD8446 (list Delta_O 0) '(0 0) AngT))	
	(setq Data (subst (cons Co (mapcar '+ Pt1 Delta_U))(assoc Co Data) Data))		
	(entmod Data)
	(setq i (1+ i))
)
(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))	
(princ)
)
(defun TextInsP_Text ( ObjName Value72_73_71 / Data OrgPosition NewPosition Org_11 New_11 )

	(setq Data (entget	ObjName))				
	(setq OrgPosition (cdr (assoc 10 Data)))		
	(setq Org_11 (cdr (assoc 11 Data)))			
	(setq Data (subst (cons 72 (car Value72_73_71)) (assoc 72 Data) Data))
	(setq Data (subst (cons 73 (cadr Value72_73_71)) (assoc 73 Data) Data))
	(entmod Data)
	‚ª–³‚¢j
	(setq NewPosition (cdr (assoc 10 (entget  ObjName))))	
	(setq Delta (mapcar '- OrgPosition NewPosition))				
	(setq New_11 (mapcar '+ Org_11 Delta))		
	(setq Data (entget	ObjName))					
	(setq Data (subst (cons 11 New_11) (assoc 11 Data)	Data))	
	(entmod Data)
)
(defun TextInsP_MText ( ObjName Value72_73_71 / Data X_Old X_New Y_Old Y_New Scale Base0 W_42 Ang_50 Delta )
	(setq Data (entget	ObjName))
	(setq InsP (cdr (assoc 10 Data)))
	(setq W_42	(cdr (assoc 42 (entget ObjName))))
	(setq H_43	 	(cdr (assoc 43 (entget ObjName))))
	(setq Ang (cdr (assoc 50 Data)))		
	(setq AngU (angle '(0 0) (getvar "UCSXDIR")))	
	(setq OldIP (cdr (assoc 71 Data)))			
	(setq NewIP (caddr Value72_73_71))		

	(setq Data (subst (cons 71 NewIP) (assoc 71 Data) Data))
	(entmod Data)


	(setq X_Old (- (+ OldIP 2) (* (fix ( / (+ OldIP 2) 3)) 3)))
	(setq X_New (- (+ NewIP 2) (* (fix ( / (+ NewIP 2) 3)) 3)))


	(setq Y_Old (fix ( / (- OldIP 1) 3)))
	(setq Y_New (fix ( / (- NewIP 1) 3)))

	(setq IncUnit (list (- X_New X_Old)(- Y_Old Y_New )))
	(setq Delta (mapcar '* IncUnit (list (* 0.5 W_42)(* 0.5 H_43))))

	(setq Delta (SD8446 Delta '(0 0) Ang))

·
	(setq Delta (SD1862 Delta (* -1.0 AngU)))

	(setq Data (subst (cons 10 (mapcar '+ InsP Delta))(assoc 10 Data) Data))
	(entmod Data)

)

 

Tiếp theo, thực hiện test so sánh :

Lần 1: với 100 text và sắp xếp bên trái :

 

-> gần như là ngay tức thì

 

Lần 2, e chơi sang làm hẳn 1000 text + Mtext đi .Lần này thì :

 

- > :undecided:

 

Vậy là tương quan,2 lisp chênh nhau về thời gian xử lý khoảng 50 lần.Tất nhiên, ngoài thực tế ít khi ta gặp 1 đoạn văn bản CAD dài như vậy, nhưng nhiều khi, 1 vấn đề đã cũ,mà vẫn có nhiều lựa chọn giải quyết.

 

PS :Còn đoạn code FIT + code sắp xếp Đối tượng cũng khù khoằm như vậy,tí rỗi e post típ ^^

bạn ketxu rất hăng hái trong diễn đàn. Cảm ơn bài viết của bạn. Mình ủng hộ bạ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

ketxu    2.983

ketxu
Đã đăng

Cám ơn bạn đã phát hiện.Có thể do 4rum bị lỗi tạm thời hoặc mắt mũi mình tèm nhèm cóp k hết, nên để chắc ăn mình up lại file lisp bên dưới bài 1 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

ketxu    2.983

ketxu
Đã đăng
bạn ketxu rất hăng hái trong diễn đàn. Cảm ơn bài viết của bạn. Mình ủng hộ bạn

Hề hề :undecided: Được câu nói mát lòng mát dạ.CV toàn ng nhiệt tình (như và) hơn mình th :"> Tks bạ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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
Cám ơn bạn đã phát hiện.Có thể do 4rum bị lỗi tạm thời hoặc mắt mũi mình tèm nhèm cóp k hết, nên để chắc ăn mình up lại file lisp bên dưới bài 1 rồi đó ^^ :">

Hề hề hề,

Chào bác ketxu,

Cám ơn bác đã chia xẻ với mọi người những thông tin hữu ích.

Sau khi đọc lướt qua thấy cái lisp của nhật bổn nó có sử dụng hai cái hàm (SD8446 .....) và (SD1862 ....) mà mình chả hiểu cái hàm này nó có răng hay không nữa bác ạ.....

Bác có thông tin gì về nó có thể cho anh em biết tí xíu được không ạ.

Hề hề hề,....

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

ketxu    2.983

ketxu
Đã đăng

Ý,hí hí,nó ở trong file lisp support nên e để sót,lúc test trên máy mình thì quên béng mất,e đã kèm theo rồi đấy ạ :undecided:

 

P/S : e còn ít tuổi mà ... :|

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

Thaistreetz    539

Thaistreetz
Đã đăng

hehe, lisp trên là 1 trong mấy lisp đầu tay của mình ở cadviet. toàn dùng hàm command để move text nên nó chậm là đúng rùi. với lại nó sảy ra lỗi khi dùng cho các loại text và Mtext có thuộc tính annotative (bản vẽ cty mình toàn text loại này) nên mình bỏ nó chẳng buồn sửa nữa. lười viết lại nên giờ chuyển qua dùng lisp của cty :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

ketxu    2.983

ketxu
Đã đăng

Bác đệu thật.Thế mà cứ găm mãi.E vẫn dùng nó từ khi đi làm đến giờ đấy >".

P/S : lisp trên cũng bay text khi text chọn làm mẫu không thuộc tập chọn ban đầu,n được cái tốt là Mờ tếch mờ tiếc k bị thay đổi format ^^

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

18011985    62

18011985
Đã đăng
Trước giờ, e vẫn dùng lisp ft của bác Đường Thái để căn lề cho text, cảm thấy rất ưng ý rồi, cứ ngỡ rằng như thế là đủ...Vừa rồi lớ ngớ mò vào trang Nhật Bổn, mót được cái này,e liền làm thử bài đánh giá, thấy tốc độ khá tốt, các bác thử chém gió xem sao, và vì code dài nên e cũng chẳng hiểu tại sao ^^

 

Mạn phép bác Thái,E xin post lại lisp ft của bác, thêm dòng check time :

 

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(setq oldang (getvar "Angbase"))
(command "angbase" 0 "ucs" "w")

(setq time (getvar "MILLISECS"))

(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" 0 txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "angbase" oldang)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")

(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))

(prompt"\nText da duoc sap xep lai\n")
(command "undo" "end")
);defun

 

Bên dưới là code khác,dài hơn,cũng với chức năng tương tự (và đổi Insert point của text) :


(defun c:trai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Left and align to Left")					
(setq Value72_73_71  '(0 0 7))
(setq AssocL '(10 10))
(Procedure)
(princ)
)

(defun c:giua ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)

(princ "\n Change Insetion point to Center and align to Center")							
(setq Value72_73_71 '(1 0 8))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

(defun c:phai ( / ObjSet ObjName ObjName0 Data Value72_73_71 Co AssocL
						Data0 Ang1 AngT Ang2 Pt0 Pt0_U Pt0_O i)
(princ "\n Change Insetion point to Right and align to Right")							

(setq Value72_73_71 '(2 0 9))
(setq AssocL '(11 10))
(Procedure)
(princ)
)

;***************************************************
(defun Procedure ()
(while (= ObjSet nil)
	(setq ObjSet (ssget '((-4 . ""))))
)
(setq ObjName0 (car (entsel "\n")))	
(setq i 0)
(setq time (getvar "MILLISECS"))
(repeat (sslength ObjSet)
	(setq ObjName (ssname ObjSet i))
	(setq Data (entget	ObjName))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")
				(TextInsP_Text ObjName Value72_73_71)	
				(setq Co (car AssocL))
			)
			(	(= (cdr(assoc 0 Data)) "MTEXT")		
				(TextInsP_MText ObjName Value72_73_71)	
				(setq Co (cadr AssocL))
			)
	)
	(setq i (1+ i))
)


(setq Data0 (entget ObjName0))
(setq Ang1 (angle '(0 0) (getvar "UCSXDIR")))
(cond 	((= (cdr(assoc 0 Data0)) "TEXT")
		(setq AngT (cdr(assoc 50 Data0)))				
		(setq Ang2 (- AngT Ang1))					
		(setq Co (car AssocL))
		)
		((= (cdr(assoc 0 Data0)) "MTEXT")
		(setq Ang2 (cdr(assoc 50 Data0)))			
		(setq AngT (+ Ang1 Ang2))					
		(setq Co (cadr AssocL))
		)
)
(setq Pt0 (cdr (assoc Co Data0)))		
(setq Pt0_U (trans Pt0 0 1))			
(setq Pt0_O (SD1862 Pt0_U Ang2))	

(setq i 0)
(repeat (sslength ObjSet)
	(setq Data (entget (setq ObjName (ssname ObjSet i))))
	(cond 	((= (cdr(assoc 0 Data)) "TEXT")(setq Co (car AssocL)))
			((= (cdr(assoc 0 Data)) "MTEXT")(setq Co (cadr AssocL)))
	)
	(setq Pt1 (cdr (assoc Co Data)))				
	(setq Pt1_U (trans Pt1 0 1))				
	(setq Pt1_O (SD1862 Pt1_U Ang2))		
	(setq Delta_O (- (car Pt0_O) (car Pt1_O)))		
	(setq Delta_U (SD8446 (list Delta_O 0) '(0 0) AngT))	
	(setq Data (subst (cons Co (mapcar '+ Pt1 Delta_U))(assoc Co Data) Data))		
	(entmod Data)
	(setq i (1+ i))
)
(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "\nThoi gian thuc hien (giay) :" (rtos time)))	
(princ)
)
(defun TextInsP_Text ( ObjName Value72_73_71 / Data OrgPosition NewPosition Org_11 New_11 )

	(setq Data (entget	ObjName))				
	(setq OrgPosition (cdr (assoc 10 Data)))		
	(setq Org_11 (cdr (assoc 11 Data)))			,0,0j
	(setq Data (subst (cons 72 (car Value72_73_71)) (assoc 72 Data) Data))
	(setq Data (subst (cons 73 (cadr Value72_73_71)) (assoc 73 Data) Data))
	(entmod Data)

	(setq NewPosition (cdr (assoc 10 (entget  ObjName))))	
	(setq Delta (mapcar '- OrgPosition NewPosition))				
	(setq New_11 (mapcar '+ Org_11 Delta))		
	(setq Data (entget	ObjName))					
	(setq Data (subst (cons 11 New_11) (assoc 11 Data)	Data))	
	(entmod Data)
)
(defun TextInsP_MText ( ObjName Value72_73_71 / Data X_Old X_New Y_Old Y_New Scale Base0 W_42 Ang_50 Delta )
	(setq Data (entget	ObjName))
	(setq InsP (cdr (assoc 10 Data)))
	(setq W_42	(cdr (assoc 42 (entget ObjName))))
	(setq H_43	 	(cdr (assoc 43 (entget ObjName))))
	(setq Ang (cdr (assoc 50 Data)))		
	(setq AngU (angle '(0 0) (getvar "UCSXDIR")))	
	(setq OldIP (cdr (assoc 71 Data)))			
	(setq NewIP (caddr Value72_73_71))		

	(setq Data (subst (cons 71 NewIP) (assoc 71 Data) Data))
	(entmod Data)


	(setq X_Old (- (+ OldIP 2) (* (fix ( / (+ OldIP 2) 3)) 3)))
	(setq X_New (- (+ NewIP 2) (* (fix ( / (+ NewIP 2) 3)) 3)))


	(setq Y_Old (fix ( / (- OldIP 1) 3)))
	(setq Y_New (fix ( / (- NewIP 1) 3)))

	(setq IncUnit (list (- X_New X_Old)(- Y_Old Y_New )))
	(setq Delta (mapcar '* IncUnit (list (* 0.5 W_42)(* 0.5 H_43))))

	(setq Delta (SD8446 Delta '(0 0) Ang))

·
	(setq Delta (SD1862 Delta (* -1.0 AngU)))

	(setq Data (subst (cons 10 (mapcar '+ InsP Delta))(assoc 10 Data) Data))
	(entmod Data)

)

(defun SD1862 (OldPt Ang / NewCs)
(setq NewCs (SD8446 '(1 0) '(0 0) Ang))
(setq NewPt (trans OldPt 0 NewCs))
(setq NewPt (list (nth 2 NewPt)(nth 0 NewPt)))
NewPt
)

(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
)

 

Tiếp theo, thực hiện test so sánh :

Lần 1: với 100 text và sắp xếp bên trái :

 

-> gần như là ngay tức thì

 

Lần 2, e chơi sang làm hẳn 1000 text + Mtext đi .Lần này thì :

 

- > :undecided:

 

Vậy là tương quan,2 lisp chênh nhau về thời gian xử lý khoảng 50 lần.Tất nhiên, ngoài thực tế ít khi ta gặp 1 đoạn văn bản CAD dài như vậy, nhưng nhiều khi, 1 vấn đề đã cũ,mà vẫn có nhiều lựa chọn giải quyết.

 

PS :Còn đoạn code FIT + code sắp xếp Đối tượng cũng khù khoằm như vậy,tí rỗi e post típ ^^

 

P/S 2 : hình như 4room lại trục trặc, e post file lisp đây

Lisp

hì hì các bác cho em tham gia thử với http://www.cadviet.com/forum/index.php?showtopic=24188

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

ketxu    2.983

ketxu
Đã đăng

Khổ quá,cái của bác nhìn ngon quá mà bác để trong VLX thì e biết mần răng.Bác thêm code test time trước vòng lặp của bác đ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

Thaistreetz    539

Thaistreetz
Đã đăng
Bác đệu thật.Thế mà cứ găm mãi.E vẫn dùng nó từ khi đi làm đến giờ đấy >"< ( 4 tháng rùi chứ ít ỏi j) .Thế pác post lên đi :">.

P/S : lisp trên cũng bay text khi text chọn làm mẫu không thuộc tập chọn ban đầu,n được cái tốt là Mờ tếch mờ tiếc k bị thay đổi format ^^

Hề hề, Lisp mình viết thì mình luôn sẵn lòng chia xẻ, nhưng những lisp của anh em trong cty viết thì mình chịu rùi, bọn nó chém mình lun á :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

18011985    62

18011985
Đã đăng
Khổ quá,cái của bác nhìn ngon quá mà bác để trong VLX thì e biết mần răng.Bác thêm code test time trước vòng lặp của bác đi ^^

hê hê từ lúc bắt đầu dialog đến lúc kết thúc là ...... (tuỳ thuộc vào thao tác người làm).

Đây là kết quả test

Select objects: Specify opposite corner: 767 found

Select objects:

Chän vÞ trÝ c¨n chØnh:
Thoi gian thuc hien (giay) :4.9690

Được cái là chỉ phải ấn nút thui hì hì. Phạm vi của lsp đối với toạ độ World và đối tượng là text và Mtext còn text thuộc tính đang ở ngoài luồng hì hì hì.

Select objects: Specify opposite corner: 17641 found

Select objects:

Chän vÞ trÝ c¨n chØnh:
Thoi gian thuc hien (giay) :16.3750

Hix mất lâu thật.

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.983

ketxu
Đã đăng

Chẹp.Thế là nhanh lắm rồi.Kể bác test đc chỉ thao tác lặp thôi thì hay,vì lúc hiện dialog,thao tác ảnh hưởng nhiều đến kquả quá mà :undecided: Con số 17641 obj cũng đáng nể thật ^^.Máy e cùi,k biết chọn bao lâu mới đc 17k đối tượng,bác nhân tiện test luôn thử hộ e nhé :leluoi:

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

18011985    62

18011985
Đã đăng
Chẹp.Thế là nhanh lắm rồi.Kể bác test đc chỉ thao tác lặp thôi thì hay,vì lúc hiện dialog,thao tác ảnh hưởng nhiều đến kquả quá mà :undecided: Con số 17641 obj cũng đáng nể thật ^^.Máy e cùi,k biết chọn bao lâu mới đc 17k đối tượng,bác nhân tiện test luôn thử hộ e nhé :leluoi:

Của bác đây máy mình cũng tàm tạm. Thiết kế thì ok không vấn đề gì.

Command:  TRAI
Change Insetion point to Left and align to Left
Select objects: Specify opposite corner: 42368 found

Select objects:


Thoi gian thuc hien (giay) :153.6720

Đây là của mình

Command: ik

Select objects: Specify opposite corner: 42368 found

Select objects:

Chän vÞ trÝ c¨n chØnh:
Thoi gian thuc hien (giay) :30.7030

Chọn đối tượng trước cho bạn sau đó thực hiện lệnh thì kết quả như sau:

Command: trai

Change Insetion point to Left and align to Left42368 found


Thoi gian thuc hien (giay) :82.4370

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

VUVUZELA    100

VUVUZELA
Đã đăng
Vậy là nhanh gấp mấy lần rồi.Bác share code hoặc hướng đi :">

 

Code đây bạn ơi

Chịu khó lên mạng tìm sẽ thấy hết

 

http://www.planetsourcecode.com/vb/scripts...3&lngWId=13

 

Cái này chuyên trị về TEXT (có từ hồi R14)

: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

hdg2318    31

hdg2318
Đã đăng

hehe, đã down được cái lisp của bạn ketxu , đã test, công nhận chạy nhanh thật, nhưng ko biết có cái giãn dòng như của bác Thái ko?? (kể mà có thì tốt quá :undecided: )

còn cái lisp của VuVuZeLa, mình chưa có thời gian test, nhìn qua cái ScreenShoot trên trang chủ thấy có vẻ hơi loằng ngoằng, ko biết lúc dùng sẽ ra sao.

 

Thanks anyway!!! :leluoi:

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

ketxu    2.983

ketxu
Đã đăng

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)(	(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_Y 0))(setq EPs (- pi EPe_org) 		EPe (- pi EPs_org)))		;X- Y+
					((and (						((and (				)

			(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 (				(and (			)
		(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_Y 0))(setq EPs (- pi EPe_org) 		EPe (- pi EPs_org)))		;X- Y+
					((and (						((and (				)				
			(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 (			((and (			((and (			((and (	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 (				(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 ^^

Command: Specify opposite corner:

Command: trai

41180 found

 

Select Reference Object:

Thoi gian thuc hien (giay) :64.959

  • Vote tăng 3

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

ketxu    2.983

ketxu
Đã đăng

Haizà..Bác lại xỉa bọn e rùi.Cái ngắn dài của code là cái người dùng k biết,cái thời gian hoàn thành sứ mệnh mới là cái Cadman cảm nhận..mà bác ém làm chi hè.

Cái mình biết mà không cho người ta biết là mình biết thì người ta lại nghĩ mình không biết cái mà mình biết nhưng người ta chưa biế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

VUVUZELA    100

VUVUZELA
Đã đăng
Haizà..Bác lại xỉa bọn e rùi.Cái ngắn dài của code là cái người dùng k biết,cái thời gian hoàn thành sứ mệnh mới là cái Cadman cảm nhận..mà bác ém làm chi hè.

^^

 

Chài

Cần câu cơm của ổng đó thì phải ém thui

: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

dthoang.ktnk1    0

dthoang.ktnk1
Đã đăng

chào các bác.em la sinh viên mới ra trường.kiến thức cad của em còn nhiều hạn chế.em mong các bác có tài liệu về hướng dẫn học cad xin gửi cho em vào mail:dthoang.ktnk1@gmail.com

em xin cám ơ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

18011985    62

18011985
Đã đăng (Đă chỉnh sửa)
Haizà..Bác lại xỉa bọn e rùi.Cái ngắn dài của code là cái người dùng k biết,cái thời gian hoàn thành sứ mệnh mới là cái Cadman cảm nhận..mà bác ém làm chi hè.

^^

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;
}

Chỉnh sửa theo phamthanhbinh
Bố trí lại cho vừa trang
  • Vote tăng 3

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
Về Đầu Trang AutoLisp
×