;選択した文座標文字列について、位置合わせ点は変えずに文字列の基点を変更


;(R)=ARES
;2024/02/16
;2023/06/20


;**************** 左上(TL)
(defun C:TextBaseTL ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "TL")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 中央上(TC)
(defun C:TextBaseTC ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "TC")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 右上(TR)
(defun C:TextBaseTR ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "TR")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 左中央(ML)
(defun C:TextBaseML ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "ML")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 中央(MC)
(defun C:TextBaseMC ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "MC")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 右中央(MR)
(defun C:TextBaseMR ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "MR")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 左下(BL)
(defun C:TextBaseBL ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "BL")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 中央下(BC)
(defun C:TextBaseBC ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "BC")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------


;**************** 右下(BR)
(defun C:TextBaseBR ( / Obj Ent TextObj Posi00 MyBase)
;****************
    (princ "\n***  座標文字列を選択  ***：")
    (setq Obj (ssget '((0 . "MTEXT"))))
    (if (not(= Obj nil));;MTEXTが選択されていたら・・・
        (progn
            (Setenv "文字位置" "BR")
            (SubRoutine)
        ) 
    ;Else MTEXTが選択されなかったら・・・
        (alert "選択エラー：座標文字列（MTEXT）が選択されていません") 
    );End if
    (princ)
);--------------------------------










;選択した文座標文字列について、位置合わせ点は変えずに文字列の基点を変更
;=====================
(defun SubRoutine()
;=====================
    (setq Posi00 (getenv "文字位置"))
    (cond
        ((= Posi00 "TL")
                    (setq MyBase 1))
        ((= Posi00 "TC")
                    (setq MyBase 2))
        ((= Posi00 "TR")
                    (setq MyBase 3))
        ((= Posi00 "ML")
                    (setq MyBase 4))
        ((= Posi00 "MC")
                    (setq MyBase 5))
        ((= Posi00 "MR")
                    (setq MyBase 6))
        ((= Posi00 "BL")
                    (setq MyBase 7))
        ((= Posi00 "BC")
                    (setq MyBase 8))
        ((= Posi00 "BR")
                    (setq MyBase 9))
        (T
                    (setq MyBase 4))
    );cond
    ;+++++++
    (setq cnt 0)
    (setq num (sslength Obj))
    ;(alert  (strcat "\n選択数："  (rtos num) "\n")) 
    (while (< cnt num)
        (setq Ent (ssname Obj cnt))
        (setq TextObj  (entget Ent))

        (setq TextObj  
            (subst 
                (cons 71 MyBase);新しい値
                (assoc 71 TextObj );古い値
                TextObj 
            );subst;Entに入っているDXF図形情報のリストを
        );setq
        (entmod TextObj) ;DXF図形情報を図形に反映
        (setq cnt (1+ cnt)
        )
    ); while
    (princ)
);--------------------------------