;文字をそろえて、同時に基点を変更する
;均等間隔で並べなおす
;行間隔を[2][8]キーで、画面を見ながら調節できる
;ガバっと選択しても順序が変わらない
;TEXT、MTEXT混在も可
;UCS対応
;文字が傾いていてもその傾きなりに位置そろえする

;Shusei Hayashi
;OffshoreCad&Management Inc.
;10F Jaka Bldg., 6780 Ayala Ave.,
;Makati, Philippines
;http://www.offshorecad.com.ph/
;http://www.offshore-management.com.ph/

(defun c:SD_515 ( / Value72_73_71 ObjSet ObjName0 i m ObjName Data Data0 Ang1 AngT Ang2 
							Pt0 Pt0_U Pt0_O Pt1 Pt1_U Pt1_O Delta_O Delta_U PtL
							OrgPt OrgH OrgAng Item Delta NewPt n pt3 KeyX)
	(if (= SD:Lang "E")	
		(princ "\n Align, Change insertion Point and adjust distance between rows")					
		(princ "\n 文字をそろえて、基点を変更し、さらに行間隔を[A][D]キーで調節する")
	)
	(princ "\n **********************************")					
							
	(setq Value72_73_71 (list 0 0 7))
	(setq AssocL '(10 10))
	(Procedure_515 nil)
	(princ)
)
;==========================================	
(defun Procedure_515 (flag)

	(setq *error* *myerror*)
	(SD1028)
	
	(while (= ObjSet nil)
		(setq ObjSet (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))
	)
	(if (= SD:Lang "E")
		(setq ObjName0 (car (entsel "\n Select Reference Object: ")))	;基準の選択
		(setq ObjName0 (car (entsel "\n 基準となる図形を選択： ")))	;基準の選択
	)
		
	;最初に基点を変更しentmod
	(setq i 0)
	(repeat (setq m (sslength ObjSet))
		(setq ObjName (ssname ObjSet i))
		(setq Data (entget	ObjName))
		(cond 	((= (cdr(assoc 0 Data)) "TEXT")
					(TextInsP_Text ObjName Value72_73_71)	;511でTEXTの基点変更
					(setq Co2 (car AssocL))
				)
				(	(= (cdr(assoc 0 Data)) "MTEXT")
					(TextInsP_MText ObjName Value72_73_71)	;511でMTEXTの基点変更
					(setq Co2 (cadr AssocL))
				)
		)
		(setq i (1+ i))
	)
	
	;基準の図形から角度の収集
	(setq Data0 (entget ObjName0))
	(setq OrgH (cdr (assoc 40 Data0)))	;文字高さ
	(setq Ang1 (angle '(0 0) (getvar "UCSXDIR")))	;UCS角度
	(cond 	((= (cdr(assoc 0 Data0)) "TEXT")
			(setq AngT (cdr(assoc 50 Data0)))				;OBJ角度on WCS(TEXTの場合)
			(setq Ang2 (- AngT Ang1))					;OBJ角度on UCS
			(setq Co2 (car AssocL))
			)
			((= (cdr(assoc 0 Data0)) "MTEXT")
			(setq Ang2 (cdr(assoc 50 Data0)))			;OBJ角度on UCS(MTEXTの場合)
			(setq AngT (+ Ang1 Ang2))					;OBJ角度on WCS(MTEXTの場合)
			(setq Co2 (cadr AssocL))
			)
	)
	
	(setq Pt0 (cdr (assoc Co2 Data0)))		;基点WCS
	
	;ガバっと選択した場合でも順番がずれないようにObjに沿った座標系におけるY座標の値でリスト化
	(setq i 0)
	(repeat m
		(setq Data (entget (ssname ObjSet i)))
		(cond 	((= (cdr(assoc 0 Data)) "TEXT")
					(setq Co2 (car AssocL))
					(setq PtH (cdr (assoc 40 Data)))	;それぞれの文字基点
				)
				((= (cdr(assoc 0 Data)) "MTEXT")
					(setq Co2 (cadr AssocL))
					(setq PtH (cdr (assoc 43 Data)))	;それぞれの文字基点
				)
		)
		(setq Pt1 (cdr(assoc Co2 Data)))	;それぞれの基点WCS
		(setq Pt1 (trans Pt1 0 1))
		(setq Pt1 (SD1862 Pt1 Ang2))
		(setq PtL (append PtL (list (list (cadr Pt1) PtH i))))
		(setq i (1+ i))
	)
	；Y座標で並べ替え
	(setq PtL (vl-sort PtL (function (lambda (e1 e2)(> (car e1) (car e2))))))
	
	;個数分の基点座標リストPtL2を用意
	(setq i 1 Co 1.2)
	(setq PtL2 (list Pt0))
	(setq PrevPt Pt0)
	(repeat (1- m)
		(setq Delta (list 0 (* -1 Co (cadr (nth i PtL)))))	;OCS座標差
		(setq Delta (SD8446 Delta '(0 0) AngT))					;WCS
		(setq NewPt (mapcar '+ PrevPt Delta))
		(setq PrevPt NewPt)
		(setq PtL2 (append PtL2 (list NewPt)))
		(setq i (1+ i))
	)
	;１回目作図	
	(setq i 0)
	(repeat m
		(setq Data (entget (ssname ObjSet (nth 2 (nth i PtL)))))
		(cond 	((= (cdr(assoc 0 Data)) "TEXT")(setq Co2 (car AssocL)))
				((= (cdr(assoc 0 Data)) "MTEXT")(setq Co2 (cadr AssocL)))
		)
		(setq Data (subst (append  (list Co2) (nth i PtL2))(assoc Co2 Data) Data))
		(entmod Data)
		(setq i (1+ i))
	)
	(if flag
		(progn 
			(command "move" ObjSet "" Pt0 midpnt1)
			(setq Pt0 midpnt1)
		)
	)
	(if (= SD:Lang "E")
		(progn
			(princ "\n [ A ]  Make the Space Narrower" )
			(princ "\n [ D ]  Make the Space Bigger \n" )
		)
		(progn
			(princ "\n [ A ]  行間スペースを狭く" )
			(princ "\n [ D ]  行間スペースを大きく \n" )
		)
	)
	
	(setq pt3 nil)
	(while (and (/= (car pt3) 3)(/= (car pt3) 11)(/= (cadr pt3) 32))
		(setq pt3 (grread nil 2 0))	;カーソルの座標
		(setq KeyX (cadr pt3))
		(cond 	((or (= KeyX 97)(= KeyX 65))
				(setq Co (- Co 0.1))
				)
				((or (= KeyX 100)(= KeyX 68))
				(setq Co (+ Co 0.1))
				)
		)
		(princ "\r                                                          ")		
		(princ (strcat "\r " (rtos (* OrgH Co)) " mm"))
		(if (equal Co 1.2 0.01)(princ " Standard"))

		;個数分の基点座標リストPtL2を用意
		(setq i 1)
		(setq PtL2 (list Pt0))
		(setq PrevPt Pt0)
		(repeat (1- m)
			(setq Delta (list 0 (* -1 Co (cadr (nth i PtL)))))	;OCS座標差
			(setq Delta (SD8446 Delta '(0 0) AngT))					;WCS
			(setq NewPt (mapcar '+ PrevPt Delta))
			(setq PrevPt NewPt)
			(setq PtL2 (append PtL2 (list NewPt)))
			(setq i (1+ i))
		)
		(setq i 0)
		(repeat m
			(setq Data (entget (ssname ObjSet (nth 2 (nth i PtL)))))
			(cond 	((= (cdr(assoc 0 Data)) "TEXT")(setq Co2 (car AssocL)))
					((= (cdr(assoc 0 Data)) "MTEXT")(setq Co2 (cadr AssocL)))
			)
			(setq Data (subst (append  (list Co2) (nth i PtL2))(assoc Co2 Data) Data))
			(entmod Data)
			(setq i (1+ i))
		)
	)
	
	(SD2056)
	(setq *error* nil)
	(princ)	
)
;�@TEXTの基点変更++++++++++++++++++++++

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

		;基点を変更
		(setq Data (entget	ObjName))				;基点変更前のデータ取得
		(setq OrgPosition (cdr (assoc 10 Data)))		;基点変更前の�I
		(setq Org_11 (cdr (assoc 11 Data)))			;基点変更前の�J（左寄せの場合この値は0,0,0）
		(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))))	;基点変更後の�I
		(setq Delta (mapcar '- OrgPosition NewPosition))				;その差から変わった量を計算
		(setq New_11 (mapcar '+ Org_11 Delta))		;新しい�J
		(setq Data (entget	ObjName))					;変更後のデータ取得
		(setq Data (subst (cons 11 New_11) (assoc 11 Data)	Data))	;�Jの変更を実行
		(entmod Data)
)

;�AMTEXTの基点変更++++++++++++++++++++++

(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)))		;オブジェクトの角度UCS
		(setq AngU (angle '(0 0) (getvar "UCSXDIR")))	;UCSの回転角度
		(setq OldIP (cdr (assoc 71 Data)))			;古い挿入起点記号
		(setq NewIP (caddr Value72_73_71))		;新しい挿入起点
		;基点を変更
		(setq Data (subst (cons 71 NewIP) (assoc 71 Data) Data))
		(entmod Data)
		
;		;X方向 何列目から何列目へ
		(setq X_Old (- (+ OldIP 2) (* (fix ( / (+ OldIP 2) 3)) 3)))
		(setq X_New (- (+ NewIP 2) (* (fix ( / (+ NewIP 2) 3)) 3)))
		
;		;Y方向 何列目から何列目へ
		(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))))
;		;UCSに戻す
		(setq Delta (SD8446 Delta '(0 0) Ang))

;		;WCSに戻す
		(setq Delta (SD1862 Delta (* -1.0 AngU)))
		
		(setq Data (subst (cons 10 (mapcar '+ InsP Delta))(assoc 10 Data) Data))
		(entmod Data)

)

;****************************************************
;座標系変換（Angだけ原点周りに回転した座標系で表現する
(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
)

;;;---------Rotate----------------------------
;;;点Aを点Bを中心にαだけ回転させた座標
;;;【引き数】点A 中心 角度α
;;;【戻り値】点C

(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 SD1028 ()
  (setq OldCmdEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (setq OldOsmode (getvar "OSMODE"))
  (setq OldLayer (getvar "CLAYER"))
  (setq OldLType (getvar "CeLType"))
  (setq OldCeLWeight (getvar "CeLWeight"))
  (setq OldColor (getvar "CeColor"))
  (setq OldOrtho (getvar "ORTHOMODE"))
  (setq OldDStyle  (getvar "DIMSTYLE"))
  (setq OldExpert (getvar "Expert"))
  (setvar "EXPERT" 0)
  (setq Path_Lang "HKEY_CURRENT_USER\\Software\\SpeedDraftLT")
  (if (vl-registry-read Path_Lang "SD_Language" )
  	(setq SD:Lang (vl-registry-read Path_Lang "SD_Language" ))
  	(progn	(setq SD:Lang "J")
  			(vl-registry-write Path_Lang "SD_Language" "J")
  	)
  )
  (princ)
)
;********************************
(defun SD2056 ()
  (setvar "OSMODE" OldOsmode)
  (command "undo" "end")
  (setvar "CLAYER" OldLayer)
  (setvar "CeLType" OldLType)
  (setvar "CeLWeight" OldCeLWeight)
  (setvar "CeColor" OldColor)
  (setvar "ORTHOMODE" OldOrtho)
  (setvar "Expert" OldExpert)
  (if (and (/= (getvar "DIMSTYLE") OldDStyle)(tblsearch "DIMSTYLE" OldDStyle))
  	(command "-dimstyle" "Restore" OldDStyle)
  )
  (princ "\n (C)OffshoreCad&Management")
  (setvar "CMDECHO" OldCmdEcho)
  (princ)
)


(if (= SD:Lang "E")
	(princ "\n Command Name: SD_515 \n")
	(princ "\n コマンド名：SD_515 \n")
)
(princ)