;; txhup.lsp
;; 2026/02/08
;; f.izawa

;; ■ コマンド
;; TXHUP   : TEXT の幅は「ほぼ」そのままで文字高さを変更
;; TXGRID  : 点在する TEXT から罫線を作成(ほぼ、同じ文字高さであること)
;;           項目名の左側に余分な罫線が作成されるため、手動で修正する必要がある
;;           文字基点、位置はそのままのため、TXGG コマンドで位置を整列する必要がある
;; TXGG    : TEXT を格子内の左、中、右に整列（TEXT の基点は変更される）(btrimvx232c 収納と同じ)
;; TXPLER  : TEXT に掛かる（重複する）ポリライン化された「元 SHX フォント」を削除
;; TXGSPC  : 線分(LINE, LWPOLYLINE）で囲われた表の列幅、行高さを変更
;; TXCLIP  : 点在する TEXT の文字列をクリップボードにコピー
;; TXPASTE : クリップボードの複数の文字列を TEXT で作成、簡易的な罫線を作成

(vl-load-com)

;; TEXT の幅は「ほぼ」そのままで文字高さを変更
(defun c:txHup( / ss len i txhsum txhold txhnew ent txwsc txwsc2)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq len (sslength ss) i 0 txhsum 0.0 )
      (repeat len
        (setq txhsum (+ txhsum (cdr (assoc 40 (entget (ssname ss i))))))
        (setq i (1+ i))
      )
      (setq txhold (/ txhsum len));; 文字高さの平均
      (if (not (setq txhnew (getreal (strcat "\n新しい文字高さを入力 < " (rtos txhold 2 3) " > : "))))
        (setq txhnew (atof (rtos txhold 2 3)))
      )
      (setq i 0)
      (repeat len
        (setq ent (entget (ssname ss i)))
        (setq txwsc (cdr (assoc 41 ent)));; 文字幅係数
        (setq txwsc2 (* txwsc (/ txhold txhnew))) ;; 新しい文字幅係数
        (setq ent (subst (cons 40 txhnew)(assoc 40 ent) ent))
        (entmod (subst (cons 41 txwsc2)(assoc 41 ent) ent))
        (setq i (1+ i))
      )
    )
  )
)

;; 点在する TEXT から罫線を作成
;; 行高さは最初に見つかった TEXT の文字高さの 2 倍。ほぼ、同じ文字高さであること
;; TEXT の位置はそのまま、整列はしない
(defun c:TXGRID ( / ss i en data txt_h row_h pnts rows cols cur_y cur_x tmp_row tmp_col fuzz
                    margin p x x_max x_min y y_btm y_top base-pnt current-right-x max-right-x offset-x right-x-list tb txt_h1a txt_h2 
     txt_h2a )
  (vl-load-com)
  
  ;; 文字を選択
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      ;; 代表的な文字高さから基準を算出（最初に見つかった TEXT）
      (setq en (ssname ss 0))
      (setq txt_h (cdr (assoc 40 (entget en))))
      (setq txt_h2 (/ txt_h 2.0))  
      (setq row_h (* txt_h 2.0))                ; 行高さ（文字の2倍）
      (setq fuzz (* txt_h 1.0))                 ; 同一行とみなす許容範囲

      ;; 座標データの抽出
      (setq right-x-list nil)
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i))))
        (setq data (entget en))
        (setq base-pnt (cdr (assoc 10 data))) ; 挿入点
        (setq pnts (cons base-pnt pnts));; 基準は左下のみ
        (setq tb (textbox data))
        (setq offset-x (car (cadr tb))) ; 文字自体の幅
        (setq txt_h1a (cdr (assoc 40 data)))
        (setq txt_h2a (/ txt_h1a 2.0))
        (setq current-right-x (+ (car base-pnt) offset-x txt_h2a))
        (setq right-x-list (cons current-right-x right-x-list))
      )
      ;; 全体の中で一番右側の座標を決定(右端をどこまで延ばすか)
      (setq max-right-x (apply 'max right-x-list))
      
      ;; 行のグループ化と「センター座標」の算出
      (setq pnts (vl-sort pnts '(lambda (a b) (> (cadr a) (cadr b)))))
      (setq cur_y (cadar pnts) tmp_row (list (car pnts)))
      (foreach p (cdr pnts)
        (if (< (abs (- cur_y (cadr p))) fuzz)
          (setq tmp_row (cons p tmp_row))
          (progn
            ;; グループの平均Y座標を算出
            (setq rows (cons (/ (apply '+ (mapcar 'cadr tmp_row)) (length tmp_row)) rows))
            (setq tmp_row (list p) cur_y (cadr p))
          )
        )
      )
      ;; 各行のセンターY座標リスト
      (setq rows (vl-sort (cons (/ (apply '+ (mapcar 'cadr tmp_row)) (length tmp_row)) rows) '>))

      ;; 5. 列のグループ化 (X座標)
      (setq pnts (vl-sort pnts '(lambda (a b) (< (car a) (car b)))))
      (setq cur_x (caar pnts) tmp_col (list (car pnts)))
      (foreach p (cdr pnts)
        (if (< (abs (- cur_x (car p))) (* txt_h 2.0))
          (setq tmp_col (cons p tmp_col))
          (progn
            (setq cols (cons (/ (apply '+ (mapcar 'car tmp_col)) (length tmp_col)) cols))
            (setq tmp_col (list p) cur_x (car p))
          )
        )
      )
      (setq cols (vl-sort (cons (/ (apply '+ (mapcar 'car tmp_col)) (length tmp_col)) cols) '<))

      ;; 罫線の描画 (左中基点用)
      (setq margin (/ row_h 2.0))
      ;;(setq txt_h2 (/ txt_h 2.0))

      (setq x_min (- (car cols) margin))
      ;;(if (> (+ (last cols) (* txt_h 10.0)) max-right-x)
      ;;  (setq  x_max (+ (last cols) (* txt_h 10.0)))
        (setq x_max  max-right-x )
      ;;)
      (setq ;; 左中基点は既にセンターなので、そこから文字高さ分(txt_h)上下に広げる
            y_top (+ (car rows) margin txt_h2)  
            y_btm (- (last rows) txt_h2)
      ) 

      ;; 水平線の描画（各行の「上側」に線を引いていく）
      ; 最上線
      (entmake (list '(0 . "LINE") '(62 . 256) (cons 10 (list x_min y_top)) (cons 11 (list x_max y_top))))
      (foreach y rows
        (setq y (+ y txt_h2))
        ; 各行の下線
        (entmake (list '(0 . "LINE") '(62 . 256) (cons 10  (list x_min (- y txt_h ))) (cons 11 (list x_max (- y txt_h)))))
      )

      ;; 垂直線の描画
      (foreach x cols
        (entmake (list '(0 . "LINE") '(62 . 256) (cons 10 (list (- x margin) y_top)) (cons 11 (list (- x margin) y_btm))))
      )
      (entmake (list '(0 . "LINE") '(62 . 256) (cons 10  (list x_max y_top)) (cons 11  (list x_max y_btm))))
      ;; 設定を戻す
      ;;(setvar "OSMODE" old_osmode)
      (princ (strcat "\n完了: " (itoa (length rows)) "行 " (itoa (length cols)) "列の表を作成しました。"))
    )
  )
  (princ)
)

;; TEXT を格子内の左、中、右に整列（TEXT の基点は変更される）
(defun c:txgg (/ ename ptlst ang ent pts vsize off kw p1 p2 code72 code73 i loop 
               sslen ss ret dp p10 p11 mp
              ) 
  ; 2024/12/22 ４方の線分検出を文字の中心から文字の基点に変更
  (setq kw   "L"
        loop T
  )
  (while loop 
    (initget "L C R X")
    (if 
      (setq ret (getkword 
                  (strcat "\n整列する TEXT の文字基点を選択 [L:左中 /C:中中 /R:右中 /X:終了] < " 
                          kw
                          " > : "
                  )
                )
      )
      (if (= ret "X") 
        (setq loop nil)
        (setq kw ret)
      )
    )
    (if (and loop (setq ss (ssget '((0 . "TEXT"))))) 
      (progn 
        (setvar "CMDECHO" 0)
        (vl-cmdf "_UNDO" "BE")
        (setq sslen (sslength ss)
              i     0
        )
        (repeat sslen 
          (setq vsize  (getvar "VIEWSIZE")
                ename  (ssname ss i)
                ent    (entget ename)
                pts    (ifs_textbox2off ent 0.0) ;; TEXT を囲う4点
                ang    (cdr (assoc 50 ent)) ;; TEXT の角度
                code72 (cdr (assoc 72 ent))
                code73 (cdr (assoc 73 ent)) ;;ptlst (ifs_textgrid2 (midpoint (nth 0 pts) (nth 2 pts)) ang vsize)
          )
          ;;code72: 0 = Left, 1= Center, 2 = Right
          ;;code73: 0 = Baseline, 1 = Bottom, 2 = Middle, 3 = Top
          (cond 
            ((= code72 0) (setq mp (midpoint (nth 0 pts) (nth 3 pts))))
            ((= code72 1) (setq mp (midpoint (nth 0 pts) (nth 2 pts))))
            ((= code72 2) (setq mp (midpoint (nth 1 pts) (nth 2 pts))))
            (T (setq mp (midpoint (nth 0 pts) (nth 3 pts))))
          )
          (setq ptlst (ifs_textgrid2 mp ang vsize))
          (if (not ptlst) 
            (princ "\nTEXT を囲う 4 線分が見つかりません．")
            (progn 
              (cond 
                ((= kw "L")
                 (setq p1  (midpoint (nth 0 pts) (nth 3 pts))
                       off (* (distance (nth 0 ptlst) (nth 3 ptlst)) 0.5)
                       p2  (polar (midpoint (nth 0 ptlst) (nth 3 ptlst)) 
                                  ang
                                  off
                           )
                 )
                )
                ((= kw "C")
                 (setq p1 (midpoint (nth 0 pts) (nth 2 pts))
                       p2 (midpoint (nth 0 ptlst) (nth 2 ptlst))
                 )
                )
                ((= kw "R")
                 (setq p1  (midpoint (nth 1 pts) (nth 2 pts))
                       off (* (distance (nth 1 ptlst) (nth 2 ptlst)) 0.5)
                       p2  (polar (midpoint (nth 1 ptlst) (nth 2 ptlst)) 
                                  ang
                                  (- off)
                           )
                 )
                )
              )
              ; (setvar "CMDECHO" 0)
              ; (vl-cmdf "_UNDO" "BE")
              ;; 移動
              ;;(vl-cmdf "_MOVE" ename "" "non" p1 "non" p2)
              (setq ent (entget ename)
                    p10 (cdr (assoc 10 ent))
                    p11 (cdr (assoc 11 ent))
                    dp  (mapcar '- p2 p1)
                    p10 (mapcar '+ p10 dp)
                    p11 (mapcar '+ p11 dp)
                    ent (subst (cons 10 p10) (assoc 10 ent) ent)
                    ent (subst (cons 11 p11) (assoc 11 ent) ent)
              )
              (entmod ent) ;; 移動

              ;; 基点を変更
              (cond 
                ((= kw "L")
                 (setq code72 0
                       code73 2
                 )
                )
                ((= kw "C")
                 (setq code72 1
                       code73 2
                 )
                )
                ((= kw "R")
                 (setq code72 2
                       code73 2
                 )
                )
              )
              (setq ent (entget ename)
                    pts (ifs_textbox2off ent 0.0)
                    ent (subst (cons 10 (nth 0 ptlst)) (assoc 10 ent) ent)
                    ent (subst (cons 11 p2) (assoc 11 ent) ent)
                    ent (subst (cons 72 code72) (assoc 72 ent) ent)
                    ent (subst (cons 73 code73) (assoc 73 ent) ent)
              )
              (entmod ent)
              ; (vl-cmdf "_UNDO" "END")
              ; (setvar "CMDECHO" 1)
            )
          )
          (setq i (1+ i))
        )
        (vl-cmdf "_UNDO" "END")
        (setvar "CMDECHO" 1)
      )
      (setq loop nil)
    )
  )
  (princ)
)

;; テキストを囲う矩形 4 点を取得 左下基点から左回り(btrimvx232c.lsp より流用)
(defun ifs_textBox2Off (textent offset / of txbox ang sinrot cosrot t1 t2 p0 p1 p2 p3 
                        p4
                       ) 
  (setq of     (list offset offset 0.0)
        p0     (cdr (assoc 10 textent))
        ang    (cdr (assoc 50 textent))
        sinrot (sin ang)
        cosrot (cos ang)
        txbox  (textbox textent)
        t1     (car txbox)
        t2     (cadr txbox)
        t1     (mapcar '- t1 of)
        t2     (mapcar '+ t2 of)
        p1     (list 
                 (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
                 (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t1) cosrot)))
               )
        p2     (list 
                 (+ (car p0) (- (* (car t2) cosrot) (* (cadr t1) sinrot)))
                 (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t1) cosrot)))
               )
        p3     (list 
                 (+ (car p0) (- (* (car t2) cosrot) (* (cadr t2) sinrot)))
                 (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t2) cosrot)))
               )
        p4     (list 
                 (+ (car p0) (- (* (car t1) cosrot) (* (cadr t2) sinrot)))
                 (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t2) cosrot)))
               )
  )
  (list p1 p2 p3 p4)
)

;; TEXT の周囲の LINE, PLINE 同士の交点 4点を左下から左回りで返す(btrimvx232c.lsp より流用)
(defun ifs_textgrid2 (p0 ang vsize / lst pl pr pt pb ssl ssr sst ssb sslst ptlst 
                      sslen len i j k kplst kp reslst result
                     ) 
  (setq reslst nil
        pL     (polar p0 (+ ang pi) vsize) ;; 線分検索左方向
        pR     (polar p0 (+ ang 0.0) vsize) ;; 線分検索右方向
        pT     (polar p0 (+ ang (* pi 0.5)) vsize) ;; 線分検索上方向
        pB     (polar p0 (+ ang (* pi 1.5)) vsize) ;; 線分検索下方向
  )
  ;; TEXT の中央から4方向に線分を検索
  (if (setq ssL (ssget "F" (list p0 pL) '((0 . "*LINE")))) 
    (if (setq ssB (ssget "F" (list p0 pB) '((0 . "*LINE")))) 
      (if (setq ssR (ssget "F" (list p0 pR) '((0 . "*LINE")))) 
        (if (setq ssT (ssget "F" (list p0 pT) '((0 . "*LINE")))) 
          (progn 
            ;; 左から左回り
            (setq sslst (list ssL ssB ssR ssT)
                  k     0
                  ptlst (list pL pB pR pT)
            )
            (repeat 4 
              (setq sslen (sslength (nth k sslst))
                    i     0
                    kplst nil
              )
              (repeat sslen 
                (setq lst (ifs_enamePointList (ssname (nth k sslst) i))
                      len (length lst)
                      j   0
                )
                (repeat (1- len) 
                  (if 
                    (setq kp (inters p0 (nth k ptlst) (nth j lst) (nth (1+ j) lst))) ;; onseg
                    ;; 交点、線分の始点、終点のリスト
                    (setq kplst (append kplst 
                                        (list 
                                          (list kp (nth j lst) (nth (1+ j) lst))
                                        )
                                )
                    )
                  )
                  (setq j (1+ j))
                )
                (setq i (1+ i))
              )
              (if kplst 
                (progn 
                  (if (> (length kplst) 1) 
                    ;; TEXT の中央に近い順にソート
                    (setq kplst (vl-sort kplst 
                                         (function 
                                           (lambda (e1 e2) 
                                             (< (distance p0 (car e1)) 
                                                (distance p0 (car e2))
                                             )
                                           )
                                         )
                                )
                    )
                  )
                  ;;(vl-cmdf "circle" "non" (car (car kplst)) 1.0)
                  (setq reslst (append reslst (list (car kplst))))
                )
              )
              (setq k (1+ k))
            )
          )
        )
      )
    )
  )
  (if (and reslst (= 4 (length reslst))) 
    (progn 
      (setq i     0
            ptlst nil
      )
      (repeat 4 
        (if (< i 3) (setq j (1+ i)) (setq j 0))
        (if 
          (setq kp (inters (cadr (nth i reslst)) 
                           (caddr (nth i reslst))
                           (cadr (nth j reslst))
                           (caddr (nth j reslst))
                           nil
                   )
          ) ;; not onseg
          (setq ptlst (append ptlst (list kp)))
        )
        (setq i (1+ i))
      )
      ;; 左下から左回りの４点
      (if (and ptlst (= 4 (length ptlst))) 
        (setq result ptlst)
        (setq result nil)
      )
    )
  )
  result
)

;; LINE, POLYLINE の座標リスト（膨らみは無視）(btrimvx232c.lsp より流用)
(defun ifs_enamePointList (ename / ent res pt item name) 
  (setq ent  (entget ename)
        name (cdr (assoc 0 ent))
  )
  (cond 
    ((= "LINE" name)
     (setq res (list (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
    )
    ((= "LWPOLYLINE" name)
     (foreach item ent 
       (if (= (car item) 10) 
         (setq pt  (cdr item)
               res (append res (list (list (car pt) (cadr pt) 0.0)))
         )
       )
     )
     (if (= (cdr (assoc 70 ent)) 1) 
       (setq res (append res (list (car res))))
     )
    )
  )
  res
)

;; ２点間中点(btrimvx232c.lsp より流用)
(defun midpoint (p1 p2 / x) 
  (mapcar '(lambda (x) (/ x 2.0)) (mapcar '+ p1 p2))
  ;;(mapcar (function (lambda (a b) (/ (+ a b) 2.0))) p1 p2)
)
;; 選択セットを囲う矩形範囲を取得(btrimvx232c.lsp より流用)
(defun ssBoundingBox (ss / len i obj minvpt maxvpt minpt maxpt xlst ylst resMinPt 
                      resMaxPt res
                     ) 
  (if ss 
    (progn 
      (setq len (sslength ss)
            i   0
      )
      (repeat len 
        (setq Obj (vlax-ename->vla-object (ssname ss i)))
        (vla-getboundingbox Obj 'minVpt 'maxVpt)
        (setq minPt (vlax-safearray->list minVpt))
        (setq maxPt (vlax-safearray->list maxVpt))
        (if (not (equal minPt maxPt)) 
          (setq xLst (append xLst (list (car minPt) (car maxPt)))
                yLst (append yLst (list (cadr minPt) (cadr maxPt)))
          )
        )
        (setq i (1+ i))
      )
      (if (and xlst ylst) 
        (progn 
          (setq resMinPt (list (apply 'min xLst) (apply 'min yLst) 0))
          (setq resMaxPt (list (apply 'max xLst) (apply 'max yLst) 0))
          (setq res (list resMinPt resMaxPt))
        )
      )
    )
  )
  res
)

;; TEXT に掛かる（重複する）ポリライン化された「元 SHX フォント」を削除
(defun c:txpler( / ss len i ent dist cnt  dist2 pts pts2 ss2 len2 j dist3 obj p1 p2 vp1 vp2 )
  (setq cnt 0)
  (setvar "CMDECHO" 0)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (vl-cmdf "_UNDO" "BE")
      (setq len (sslength ss) i 0)
      (repeat len
        (setq ent (entget (ssname ss i)))
        ;; 左下基点から左回り
        (setq pts (ifs_textBox2Off ent 0.0))
        
        (setq dist (distance (car pts)(caddr pts)))
        (if (setq ss2 (ssget "CP" pts '((0 . "LWPOLYLINE"))))
          (progn            
            (setq pts2 (ssBoundingBox ss2))
            (setq dist2 (distance (car pts2)(cadr pts2)))
            (if (< dist2 (* dist 2.0))
              (progn
                (vl-cmdf "_ERASE" ss2 "")
                (setq cnt (+ cnt (sslength ss2)))
              )
              (progn
                (setq len2 (sslength ss2) j 0)
                (repeat len2
                  (setq Obj (vlax-ename->vla-object (ssname ss2 j)))
                  (vla-getboundingbox obj 'vp1 'vp2)
                  (setq p1 (vlax-safearray->list vp1))
                  (setq p2 (vlax-safearray->list vp2))
                  (setq dist3 (distance p1 p2))
                  (if (< dist3 (* dist 2.0))
                    (progn
                      (vl-cmdf "_ERASE" (ssname ss2 j) "")
                      (setq cnt (1+ cnt ))
                    ) 
                  )                    
                  (setq j (1+ j))
                )
              )
            )
          )
        )        
        (setq i (1+ i))
      )
      (vl-cmdf "_UNDO" "END")
    )
  )
  (setvar "CMDECHO" 1)
  (prompt (strcat "\n" (itoa cnt) " 個の TEXT に掛かるポリラインを削除しました."))
)

;; 文字列 "1, 3, 5-7" を (1 3 5 6 7)に (btrimvx232c.lsp より流用)
(defun strToNumList (str / i s c temp nlst ed j n st tmp) 
  (defun strpos (c str / ret i) 
    (setq ret 0
          i   1
    )
    (while (and (= ret 0) (<= i (strlen str))) 
      (if (= c (substr str i 1)) 
        (setq ret i)
      )
      (setq i (1+ i))
    )
    ret ;
  )
  (setq i 1
        s ""
  )
  (repeat (strlen str) 
    (if (/= " " (setq c (substr str i 1))) 
      (setq s (strcat s c))
    )
    (setq i (1+ i))
  )
  (setq str  s
        s    ""
        temp nil
        i    1
  )
  (repeat (setq n (strlen str)) 
    (if (= "," (setq c (substr str i 1))) 
      (setq temp (append temp (list s))
            s    ""
      )
      (setq s (strcat s c))
    )
    (setq i (1+ i))
  )
  (if (/= s "") 
    (setq temp (append temp (list s)))
  )
  (setq i 0)
  (repeat (length temp) 
    (setq str (nth i temp))
    (if (= 0 (setq n (strpos "-" str))) 
      (setq nlst (append nlst (list (atoi str))))
      (progn 
        (setq st (atoi (substr str 1 (1- n)))
              ed (atoi (substr str (1+ n)))
        )
        (if (> st ed) 
          (setq tmp st
                st  ed
                ed  tmp
          )
        )
        (setq j 0)
        (repeat (+ (- ed st) 1) 
          (setq nlst (append nlst (list (+ st j))))
          (setq j (1+ j))
        )
      )
    )
    (setq i (1+ i))
  )
  (setq nlst (vl-sort nlst '<))
)

;; リストの中身を入れ替える(btrimvx232c.lsp より流用)
;; Index は、0 ベース
(defun lstReplace (lst index newItem / i temp) 
  (setq i 0)
  (repeat (length lst) 
    (if (= i index) 
      (setq temp (append temp (list newItem)))
      (setq temp (append temp (list (nth i lst))))
    )
    (setq i (1+ i))
  )
  temp
)
;; LWPの2D座標と位置(0ベース)のリストを得る(btrimvx232c.lsp より流用)
(defun getLwpPointIndexList (lwpent / i temp) 
  (setq i 0)
  (repeat (length lwpent) 
    (if (= (car (nth i lwpent)) 10) 
      (setq temp (append temp (list (list (cdr (nth i lwpent)) i))))
    )
    (setq i (1+ i))
  )
  temp
)

;; 複数の文字列を、wpt1 wpt2 の窓内に配置(btrimvx232c.lsp より流用)
(defun ntxtMove (txtss x0 y0 x1 y1 txtXof txtYsp hflag / i ename ent p10 temp e1 e2 n 
                 txtH vflag x y h hsp
                ) 
  (setq i 0)
  (repeat (sslength txtss) 
    (setq ename (ssname txtss i)
          ent   (entget ename)
          p10   (cdr (assoc 10 ent))
    )
    (setq temp (append temp (list (list (cadr p10) ename)))) ;; ex: ((y1 ename1)(y2 ename2) ...)
    (setq i (1+ i))
  )
  (if temp 
    (progn 
      (setq temp (vl-sort temp (function (lambda (e1 e2) (> (car e1) (car e2)))))) ;; Y 座標の大きい順
      (setq n (length temp))
      ;; 必要文字高さ
      (setq i 0
            h 0
      )
      (repeat n 
        (setq ename (cadr (nth i temp))
              ent   (entget ename)
              txtH  (cdr (assoc 40 ent))
        )
        (setq h (+ h txtH))
        (setq i (1+ i))
      )
      ;; 文字高さの平均
      (setq h (/ h n))
      ;; 行間スペース
      (setq hsp (* h txtYsp))
      ;; 最初の文字位置 Y 座標
      (setq y (+ (/ (+ y0 y1) 2.0) (* (/ (1- n) 2.0) (+ h hsp))))
      (setq i 0)
      (repeat n 
        (setq ename (cadr (nth i temp))
              ent   (entget ename)
        )
        (setq vflag (cdr (assoc 73 ent))
              txtH  (cdr (assoc 40 ent))
        )
        (if (not hflag) (setq hflag (cdr (assoc 72 ent))))
        (cond 
          ((= hflag 0) (setq x (+ x0 (* txtH txtXof))))
          ((= hflag 1) (setq x (/ (+ x0 x1) 2.0)))
          ((= hflag 2) (setq x (- x1 (* txtH txtXof))))
          (T
           (setq x     (+ x0 (* txtH txtXof))
                 hflag 0
           )
          ) ;;
        )
        (setq ent (subst (cons 10 (list x y 0.0)) (assoc 10 ent) ent)
              ent (subst (cons 11 (list x y 0.0)) (assoc 11 ent) ent)
              ent (subst '(73 . 2) (assoc 73 ent) ent) ;; 2019/01/04 (73 . 2) を修正
              ent (subst (cons 72 hflag) (assoc 72 ent) ent)
        )
        (entmod ent)
        ;; 次の文字位置 Y 座標
        (setq y (- y (+ h hsp)))
        (setq i (1+ i))
      )
    )
  )
)

;; ｙ座標が同じTEXTを結合
;; 結合出来たとき: 残ったename、出来なかったとき: nil を返す(btrimvx232c.lsp より流用)
(defun txtcatByEnameLst (lst / i n temp y res e1 e2 ename ent p10 str) 
  (if (and lst (> (setq n (length lst)) 1)) 
    (progn 
      (setq i 0)
      (repeat n 
        (setq ename (nth i lst)
              ent   (entget ename)
              p10   (cdr (assoc 10 ent))
        )
        (if (not y) 
          (setq y    (cadr p10)
                temp (append temp (list (list (car p10) ename)))
          )
          (if (equal y (cadr p10) 0.1) 
            (setq y    (cadr p10)
                  temp (append temp (list (list (car p10) ename)))
            )
          )
        )
        (setq i (1+ i))
      )
      (if (and temp (> (length temp) 1)) 
        (progn 
          (setq temp (vl-sort temp 
                              (function (lambda (e1 e2) (< (car e1) (car e2))))
                     )
          )
          (setq i   0
                str ""
          )
          (repeat (length temp) 
            (setq ename (cadr (nth i temp))
                  ent   (entget ename)
            )
            (if (= i 0) 
              (setq str (strcat str (cdr (assoc 1 ent))))
              (setq str (strcat str " " (cdr (assoc 1 ent)))) ;; スペースを追加
            )
            (setq i (1+ i))
          )
          (setq i 0)
          (repeat (length temp) 
            (setq ename (cadr (nth i temp)))
            (if (= i 0) 
              (progn 
                (setq ent (entget ename))
                (setq ent (subst (cons 1 str) (assoc 1 ent) ent))
                (entmod ent)
                (setq res ename) ;;残った図形名
              )
              (entdel ename) ;;その他は削除
            )
            (setq i (1+ i))
          )
        )
      )
    )
  )
  res
)


;; 線分(LINE, LWPOLYLINE）で囲われた表の列幅、行高さを変更(btrimvx232c.lsp より流用)
(defun c:txgSPC (/ i j k ss xlst ylst xlstorg ylstorg etype p10 p11 ename ent temp kw 
                 str nlst flag col colWidth h row rowHeight sa w x y hflag txtH vflag 
                 x0 x1 y0 y1 loop lwplst p2D fuz txtXof fuz2 bottom checkedlst left n 
                 right top txtss txtYsp s
                ) 
  ;; 2024/11/24 最小、最大、平均の表示を追加
  (defun dispxySpace (xylst / res dist i len lst mindist maxdist total) 
    (setq len   (length xylst)
          i     0
          res   "\n"
          total 0.0
    )
    (repeat (1- len) 
      (setq dist (abs (- (nth (1+ i) xylst) (nth i xylst))))
      (setq lst (append lst (list dist)))
      (setq total (+ total dist))
      (setq res (strcat res (itoa (1+ i)) "=" (rtos dist 2 3) " "))
      (setq i (1+ i))
    )
    (setq mindist (apply 'min lst)
          maxdist (apply 'max lst)
    )
    (setq res (strcat res 
                      "\n最小="
                      (rtos mindist 2 3)
                      " 最大="
                      (rtos maxdist 2 3)
                      " 平均="
                      (rtos (/ total (1- len)) 2 3)
              )
    )
    (princ res)
    (princ)
  )

  ;; 2024/11/01 取得時の幅、高さの表示を追加
  (princ "\n TXGSPC : 線分 (LINE, LWPOLYLINE) で囲われた表の列幅、行高さを変更します．")
  ;; 文字基点のオフセット = 文字高さ x txtXof
  (setq txtXof 0.8)
  ;; 行間 = 文字高さ x txtYsp;; TTF の場合 0.5 程度、SHX の場合 0.4 程度
  (setq txtYsp 0.5)

  ;; 線分検出の誤差 fuz2 > fuz とする（2倍以上）
  (setq fuz  0.001
        fuz2 0.002
  )
  (setq i 0)
  (prompt "\n表を構成する線分 (LINE, POLYLINE) を選択します．")
  (if (setq ss (ssget '((0 . "*LINE")))) 
    (repeat (sslength ss) 
      (setq ename (ssname ss i)
            ent   (entget ename)
      )
      (setq etype (cdr (assoc 0 ent)))
      (setq j 0)
      (if (= etype "LINE") 
        (setq p10  (cdr (assoc 10 ent))
              p11  (cdr (assoc 11 ent))
              xlst (append xlst (list (car p10)))
              xlst (append xlst (list (car p11)))
              ylst (append ylst (list (cadr p10)))
              ylst (append ylst (list (cadr p11)))
        )
        (if (= etype "LWPOLYLINE") 
          (repeat (length ent) 
            (if (= (car (nth j ent)) 10) 
              (setq p10  (cdr (nth j ent))
                    xlst (append xlst (list (car p10)))
                    ylst (append ylst (list (cadr p10)))
              )
            )
            (setq j (1+ j))
          )
        )
      )
      (setq i (1+ i))
    )
  )
  ;; 格子の X, Y 座標リストを整理
  (if (and xlst ylst ss) 
    (progn 
      (setq xlst (vl-sort xlst '<)
            ylst (vl-sort ylst '>)
      )
      (setq temp (list (car xlst))
            i    0
      )
      (repeat (1- (length xlst)) 
        (if (not (equal (nth i xlst) (nth (1+ i) xlst) fuz)) 
          (setq temp (append temp (list (nth (1+ i) xlst))))
        )
        (setq i (1+ i))
      )
      (setq xlst temp
            temp (list (car ylst))
            i    0
      )
      (repeat (1- (length ylst)) 
        (if (not (equal (nth i ylst) (nth (1+ i) ylst) fuz)) 
          (setq temp (append temp (list (nth (1+ i) ylst))))
        )
        (setq i (1+ i))
      )
      (setq ylst temp
            temp nil
      )
      ;; 取得時の状態を記憶しておく
      (setq xlstorg xlst
            ylstorg ylst
      )
    )
  )
  (setq loop (and xlst ylst ss))
  ;; ここから繰り返し
  (while loop 
    ;;(setq xlst xlstorg ylst ylstorg)
    (setq w nil)
    (initget "Width Height eXit")
    (if (not (setq kw (getkword "\n変更する対象を入力[W:幅/H:高さ/X:終了(X)] < H > : "))) 
      (setq kw "Height")
    )
    (if (= kw "eXit") 
      (setq loop nil)
      (progn 
        (if (= kw "Width") 
          (progn 
            ;; 現在の間隔を表示
            (dispXySpace xlst)
            (setq s (strcat "1-" (itoa (1- (length xlst)))))
            (setq str (getstring nil 
                                 (strcat "\n対象の列番号 " s " を入力（入力例 : 1,3-5,7,8-）<" s 
                                         ">"
                                 )
                      )
            )
            (if (setq w (getreal "\n新しい幅を入力（複数は不可） < やり直し > : ")) 
              (progn 
                (if (or (not str) (= str "")) (setq str s))
                (if (= "-" (substr str (strlen str) 1)) 
                  (setq str (strcat str (itoa (1- (length xlst)))))
                )
              )
            )
          )
          (progn 
            (dispXySpace ylst)
            (setq s (strcat "1-" (itoa (1- (length ylst)))))
            (setq str (getstring nil 
                                 (strcat "\n対象の行番号 " s " を入力（入力例 : 1,3-5,7,8- ）<" s 
                                         ">"
                                 )
                      )
            )
            (if (setq h (getreal "\n新しい高さを入力（複数は不可） < やり直し > : ")) 
              (progn 
                (if (or (not str) (= str "")) (setq str s))
                ;; 2024/10/31 "8-" に対応
                (if (= "-" (substr str (strlen str) 1)) 
                  (setq str (strcat str (itoa (1- (length ylst)))))
                )
              )
            )
          )
        )
        ;;----------------------
        (if (and str (or w h)) 
          (progn 
            ;; 列、行指定の文字列を数値に展開
            (setq nlst (strToNumList str))
            ;;(princ "\nnlst=")(princ nlst)
            ;; 表のサイズ変更
            ;; 線分を移動
            ;;
            (setq i 0)
            (if (= kw "Width") 
              (repeat (length nlst) 
                (setq col (nth i nlst)) ;; 1からスタート
                (if (< col (length xlst)) 
                  (progn 
                    (setq colWidth (- (nth col xlst) (nth (1- col) xlst)))
                    (setq sa (- w colWidth)
                          j  0
                    )
                    (repeat (sslength ss) 
                      (setq ename (ssname ss j)
                            ent   (entget ename)
                            etype (cdr (assoc 0 ent))
                      )
                      (if (= etype "LINE") 
                        (progn 
                          (setq p10  (cdr (assoc 10 ent))
                                p11  (cdr (assoc 11 ent))
                                flag nil
                          )
                          (if (> (car p10) (+ (nth (1- col) xlst) fuz2)) 
                            (setq ent  (subst 
                                         (cons 10 
                                               (list (+ (car p10) sa) 
                                                     (cadr p10)
                                                     (caddr p10)
                                               )
                                         )
                                         (assoc 10 ent)
                                         ent
                                       )
                                  flag T
                            )
                          )
                          (if (> (car p11) (+ (nth (1- col) xlst) fuz2)) 
                            (setq ent  (subst 
                                         (cons 11 
                                               (list (+ (car p11) sa) 
                                                     (cadr p11)
                                                     (caddr p11)
                                               )
                                         )
                                         (assoc 11 ent)
                                         ent
                                       )
                                  flag T
                            )
                          )
                          (if flag (entmod ent))
                        )
                      )
                      (if (= etype "LWPOLYLINE") 
                        (progn 
                          (setq lwplst (getLwpPointIndexList ent))
                          (setq k    0
                                flag nil
                          )
                          (repeat (length lwplst) 
                            (setq p2D (car (nth k lwplst)))
                            (if (> (car p2D) (+ (nth (1- col) xlst) fuz2)) 
                              (setq p2D  (list (+ (car p2D) sa) (cadr p2D))
                                    flag T
                                    ent  (lstReplace 
                                           ent
                                           (cadr (nth k lwplst))
                                           (cons 10 p2D)
                                         )
                              )
                            )
                            (setq k (1+ k))
                          )
                          (if flag (entmod ent))
                        )
                      )
                      (setq j (1+ j))
                    )
                    ;; XLST を更新
                    (setq temp nil
                          j    0
                    )
                    (repeat (length xlst) 
                      (setq x (nth j xlst))
                      (if (> j (1- col)) (setq x (+ x sa)))
                      (setq temp (append temp (list x)))
                      (setq j (1+ j))
                    )
                    (setq xlst temp
                          temp nil
                    )
                  )
                )
                (setq i (1+ i))
              )
              ;; 線分移動
              (repeat (length nlst) 
                (setq row (nth i nlst)) ;; 1からスタート
                (if (< row (length ylst)) 
                  (progn 
                    (setq rowHeight (- (nth (1- row) ylst) (nth row ylst)))
                    (setq sa (- h rowHeight)
                          j  0
                    )
                    (repeat (sslength ss) 
                      (setq ename (ssname ss j)
                            ent   (entget ename)
                            etype (cdr (assoc 0 ent))
                      )
                      (if (= etype "LINE") 
                        (progn 
                          (setq p10  (cdr (assoc 10 ent))
                                p11  (cdr (assoc 11 ent))
                                flag nil
                          )
                          (if (< (cadr p10) (- (nth (1- row) ylst) fuz2)) 
                            (setq ent  (subst 
                                         (cons 10 
                                               (list (car p10) 
                                                     (- (cadr p10) sa)
                                                     (caddr p10)
                                               )
                                         )
                                         (assoc 10 ent)
                                         ent
                                       )
                                  flag T
                            )
                          )
                          (if (< (cadr p11) (- (nth (1- row) ylst) fuz2)) 
                            (setq ent  (subst 
                                         (cons 11 
                                               (list (car p11) 
                                                     (- (cadr p11) sa)
                                                     (caddr p11)
                                               )
                                         )
                                         (assoc 11 ent)
                                         ent
                                       )
                                  flag T
                            )
                          )
                          (if flag (entmod ent))
                        )
                      )
                      (if (= etype "LWPOLYLINE") 
                        (progn 
                          (setq lwplst (getLwpPointIndexList ent))
                          (setq k    0
                                flag nil
                          )
                          (repeat (length lwplst) 
                            (setq p2D (car (nth k lwplst)))
                            (if (< (cadr p2D) (- (nth (1- row) ylst) fuz2)) 
                              (setq p2D  (list (car p2D) (- (cadr p2D) sa))
                                    flag T
                                    ent  (lstReplace 
                                           ent
                                           (cadr (nth k lwplst))
                                           (cons 10 p2D)
                                         )
                              )
                            )
                            (setq k (1+ k))
                          )
                          (if flag (entmod ent))
                        )
                      )
                      (setq j (1+ j))
                    )

                    ;; YLST を更新
                    (setq temp nil
                          j    0
                    )
                    (repeat (length ylst) 
                      (setq y (nth j ylst))
                      (if (> j (1- row)) (setq y (- y sa)))
                      (setq temp (append temp (list y)))
                      (setq j (1+ j))
                    )
                    (setq ylst temp
                          temp nil
                    )
                  )
                )
                (setq i (1+ i))
              )
            )
            ;; TEXT 移動
            (setq i          0
                  checkedlst nil
            )
            (repeat (1- (length ylstorg)) 
              (setq top    (nth i ylstorg)
                    bottom (nth (1+ i) ylstorg)
                    j      0
              )
              (repeat (1- (length xlstorg)) 
                (setq left  (nth j xlstorg)
                      right (nth (1+ j) xlstorg)
                )
                (if 
                  (setq txtss (ssget "C" 
                                     (list left top)
                                     (list right bottom)
                                     '((0 . "TEXT"))
                              )
                  )
                  (progn 
                    (setq n (sslength txtss))
                    ;; 基点が窓内の図形のみ
                    ;; 枠からはみ出た TEXT 対策
                    (setq k (1- n))
                    (repeat n 
                      (setq ename (ssname txtss k)
                            ent   (entget ename)
                      )
                      (setq vflag (cdr (assoc 73 ent))
                            hflag (cdr (assoc 72 ent))
                      )
                      (if (and (= vflag 0) (= hflag 0)) 
                        (setq p10 (cdr (assoc 10 ent)))
                        (setq p10 (cdr (assoc 11 ent)))
                      )
                      (if 
                        (not 
                          (and (< left (car p10)) 
                               (<= (car p10) right)
                               (> top (cadr p10))
                               (>= (cadr p10) bottom)
                          )
                        )
                        (setq txtss (ssdel ename txtss))
                      )
                      (setq k (1- k))
                    )
                    ;; 移動済みを除外
                    (if (and txtss checkedlst) 
                      (progn 
                        (setq k 0)
                        (repeat (length checkedlst) 
                          (if (ssmemb (nth k checkedlst) txtss) 
                            (setq txtss (ssdel (nth k checkedlst) txtss))
                          )
                          (setq k (1+ k))
                        )
                      )
                    )
                    ;; 複数ある場合は、文字結合を試す（左下の基点の Y 座標が同じ時、結合する）
                    (if (and txtss (> (setq n (sslength txtss)) 1)) 
                      (progn 
                        (setq k    0
                              temp nil
                        )
                        (repeat n 
                          (setq temp (append temp (list (ssname txtss k))))
                          (setq k (1+ k))
                        )
                        (if (setq ename (txtcatByEnameLst temp)) 
                          (progn 
                            (setq k 0)
                            (repeat (length temp) 
                              (if (not (equal ename (nth k temp))) 
                                (setq txtss (ssdel (nth k temp) txtss)) ;; 結合以外は、選択セットから削除
                              )
                              (setq k (1+ k))
                            )
                          )
                        )
                      )
                    )
                    ;; 残りを移動
                    (if (and txtss (> (setq n (sslength txtss)) 0)) 
                      (progn 
                        (setq x0 (nth j xlst)
                              x1 (nth (1+ j) xlst)
                              y0 (nth i ylst)
                              y1 (nth (1+ i) ylst)
                        )
                        (if (= n 1) 
                          (progn 
                            (setq k 0)
                            (setq ename (ssname txtss k)
                                  ent   (entget ename)
                            )
                            ;; 縦方向(V)と横方向(H)の位置合わせフラグ
                            (setq vflag (cdr (assoc 73 ent))
                                  hflag (cdr (assoc 72 ent))
                                  txtH  (cdr (assoc 40 ent))
                            )
                            (cond 
                              ((= hflag 0) (setq x (+ x0 (* txtH txtXof))))
                              ((= hflag 1) (setq x (/ (+ x0 x1) 2.0)))
                              ((= hflag 2) (setq x (- x1 (* txtH txtXof))))
                              (T
                               (setq x     (+ x0 (* txtH txtXof))
                                     hflag 0
                               )
                              ) ;;
                            )
                            (setq y   (/ (+ y0 y1) 2.0)
                                  ent (subst (cons 10 (list x y 0.0)) 
                                             (assoc 10 ent)
                                             ent
                                      )
                                  ent (subst (cons 11 (list x y 0.0)) 
                                             (assoc 11 ent)
                                             ent
                                      )
                                  ent (subst '(73 . 2) (assoc 73 ent) ent) ;; 2019/01/04 (73 . 2) を修正
                                  ent (subst (cons 72 hflag) (assoc 72 ent) ent)
                            )
                            (entmod ent)
                            ;; 移動済リストに追加
                            (setq checkedlst (append checkedlst (list ename)))
                          )
                          ;; TEXT が 2 個以上
                          (progn 
                            (ntxtMove txtss x0 y0 x1 y1 txtXof txtYsp nil)
                            (setq k 0)
                            (repeat n 
                              ;; 移動済リストに追加
                              (setq checkedlst (append checkedlst 
                                                       (list (ssname txtss k))
                                               )
                              )
                              (setq k (1+ k))
                            )
                          )
                        )
                        (setq txtss nil)
                      )
                    )
                  )
                ) ;;end ssget
                (setq j (1+ j))
              )
              (setq i (1+ i))
            )
            ;; 位置情報を更新
            (setq xlstorg xlst
                  ylstorg ylst
            )
          )
        )
        ;;---------------
      ) ;; end progn
    ) ;; end if
  ) ;; end while
  (princ)
)

;; 選択した文字列をクリップボードにコピー（btrimvx232c.lsp より流用）
(defun c:txClip (/ xlst ylst colcount ename ent fuz i j k n pt rowcount s ss str temp) 
  (setq fuz 1.0)
  (setq fuz (* fuz (getvar "DIMSCALE")))

  (prompt "\n クリップボードにコピーする TEXT を選択します．")
  (if 
    (setq ss (ssget 
               '((0 . "TEXT") (-4 . "<NOT") (8 . "HOJO*,JOGAI*") (-4 . "NOT>"))
             )
    )
    (progn 
      (setq i 0)
      (repeat (sslength ss) 
        (setq ename (ssname ss i)
              ent   (entget ename)
        )
        (if (and (= 0 (cdr (assoc 72 ent))) (= 0 (cdr (assoc 73 ent)))) 
          (setq pt (cdr (assoc 10 ent)))
          (setq pt (cdr (assoc 11 ent)))
        )
        (setq xlst (append xlst (list (car pt))))
        (setq ylst (append ylst (list (cadr pt))))
        (setq i (1+ i))
      )
    )
  )
  (if (and xlst ylst) 
    (progn 
      (setq xlst (vl-sort xlst '<)
            ylst (vl-sort ylst '>)
      )
      (setq temp (list (car xlst))
            i    0
      )
      (repeat (1- (length xlst)) 
        (if (not (equal (nth i xlst) (nth (1+ i) xlst) fuz)) 
          (setq temp (append temp (list (nth (1+ i) xlst))))
        )
        (setq i (1+ i))
      )
      (setq xlst temp
            temp (list (car ylst))
            i    0
      )
      (repeat (1- (length ylst)) 
        (if (not (equal (nth i ylst) (nth (1+ i) ylst) fuz)) 
          (setq temp (append temp (list (nth (1+ i) ylst))))
        )
        (setq i (1+ i))
      )
      (setq ylst temp
            temp nil
      )
      (setq str "")
      (setq i 0)
      (repeat (setq rowcount (length ylst)) 
        (setq j 0)
        (repeat (setq colcount (length xlst)) 
          (setq s "")
          (setq n (sslength ss)
                k (1- n)
          )
          (repeat n 
            (setq ename (ssname ss k)
                  ent   (entget ename)
            )
            (if (and (= 0 (cdr (assoc 72 ent))) (= 0 (cdr (assoc 73 ent)))) 
              (setq pt (cdr (assoc 10 ent)))
              (setq pt (cdr (assoc 11 ent)))
            )
            (if (equal pt (list (nth j xlst) (nth i ylst) 0.0) fuz) 
              (progn 
                (setq s (cdr (assoc 1 ent)))
                (setq ss (ssdel ename ss))
              )
            )
            (setq k (1- k))
          )
          (setq str (strcat str s))
          (if (< j (1- colcount)) 
            (setq str (strcat str "\t"))
            (if (< i (1- rowcount))  ;;最後に CrLf が必要かどうか
              (setq str (strcat str "\r\n"))
            )
          )
          (setq j (1+ j))
        )
        (setq i (1+ i))
      )
      (if (/= str "") 
        (progn 
          (_ClearClipBoardText)
          (_SetClipBoardText str)
        )
      )
    )
  )
  (princ)
)

;; クリップボードの文字列を LIST 形式に変換（btrimvx232c.lsp より流用）
(defun clipTextToLst (delimiter / c i len lst lsts s str) 
  ;;  行区切りは  CrLf
  (if (setq str (_GetClipBoardText)) 
    (progn 
      (setq len (strlen str))
      ;; 2024/11/24
      (setq c (substr str len 1))
      (if (and (/= "\r" c) (/= "\n" c)) 
        (setq str (strcat str "\r")
              len (1+ len)
        )
      )
      (setq i 1
            s ""
      )
      (repeat len 
        (setq c (substr str i 1))
        (if (= c delimiter) 
          (setq lst (append lst (list s))
                s   ""
          )
          (if (= c "\r") 
            (setq lst  (append lst (list s))
                  s    ""
                  lsts (append lsts (list lst))
                  lst  nil
            )
            (if (/= c "\n") 
              (setq s (strcat s c))
            )
          )
        )
        (setq i (1+ i))
      )
      (if (/= s "") 
        (setq lst  (append lst (list s))
              lsts (append lsts (list lst))
              lst  nil
        )
      )
    )
  )
  lsts
)

;; クリップボードの文字列を TEXT で作成、区切り線を作成（btrimvx232c.lsp より流用）
(defun c:txPaste (/ i s lst lsts colcount d ent gen h j lay n pt rowcount txtH w esel 
                  ww hh kw txtPlus txtXof dimsc rect strW wlst wmax delimiter str
                 ) 
  (setq delimiter ",")
  (setq txtXof 0.8)
  (setq txtPlus 10) ;; 横幅調整用文字幅
  (setq dimsc (getvar "DIMSCALE"))
  (setq txtPlus (* txtPlus dimsc))
  ;; 2024/04/04
  (if (setq str (_GetClipBoardText)) 
    (if (> (ifs_strpos "\t" str) 0) 
      (setq delimiter "\t")
    )
  )

  (if (not (setq lsts (clipTextToLst delimiter))) 
    (princ "\nクリップボードに文字列がありません．")
    (progn 
      (dispClipTextLst lsts)
      ;; 最大の   Col 数を得る
      (setq rowcount (length lsts))
      (setq colcount 0
            i        0
      )
      (repeat rowcount 
        (if (< colcount (setq n (length (nth i lsts)))) 
          (setq colcount n)
        )
        (setq i (1+ i))
      )
      (setq lay (getvar "CLAYER"))
      (setq txtH (getvar "TEXTSIZE")) ;; 2025/03/17 dimscale 倍していたのを修正
      (initget "Ref eXit")
      (if (setq d (getreal (strcat "\n文字高さを入力 [参照(R)/終了(X)] <" (rtos txtH) "> :"))) 
        (if (and (/= d "Ref") (/= d "eXit")) 
          (setq txtH d)
          (if (= d "Ref") 
            (if (setq esel (entsel "\n高さを参照する TEXT を１つ選択  :   ")) 
              (setq ent  (entget (car esel))
                    txtH (cdr (assoc 40 ent))
              )
            )
          )
        )
      )
      ;; col ごとの文字幅の最大値
      (setq wlst nil)
      (setq j 0)
      (repeat colcount 
        (setq i 0)
        (setq wmax 0.0)
        (repeat rowcount 
          (if (< j (setq n (length (nth i lsts)))) 
            (progn 
              (if (setq s (nth j (nth i lsts))) 
                (if (/= s "") 
                  (progn 
                    (setq ent (list '(0 . "TEXT") 
                                    (cons 8 lay)
                                    (cons 1 s)
                                    (cons 40 txtH)
                                    '(41 . 1.0)
                                    '(50 . 0)
                                    '(10 0 0 0)
                                    '(72 . 0)
                                    '(73 . 0)
                              )
                    )
                    (setq rect (textbox ent))
                    (setq strW (- (car (cadr rect)) (car (car rect))))
                    (if (< wmax strW) 
                      (setq wmax strW)
                    )
                  )
                )
              )
            )
          )
          (setq i (1+ i))
        )
        ;; 幅を DIMSCALE の倍数に＋余裕
        (setq wmax (* (fix (+ (/ wmax dimsc) 0.5)) dimsc))
        (setq wlst (append wlst (list wmax)))
        (setq j (1+ j))
      )
      (if (/= d "eXit") 
        (progn 
          (setq h (* txtH 2.0))
          (if (> rowcount 1) 
            (if (setq d (getdist (strcat "\n改行ピッチを入力 <" (rtos h) "> :"))) 
              (setq h d)
            )
          )
          (setq gen (getpoint "\n文字作成の基点を指示 : "))
          (setq pt gen)
          (setq i 0)
          (repeat (length lsts) 
            (setq lst (nth i lsts))
            (setq j 0)
            (repeat (length lst) 
              (setq s (nth j lst))
              (if (/= s "") 
                (progn 
                  (setq ent (list '(0 . "TEXT") 
                                  (cons 8 lay)
                                  (cons 1 s)
                                  (cons 40 txtH)
                                  '(41 . 1.0)
                                  '(50 . 0)
                                  (cons 10 pt)
                                  (cons 11 pt)
                                  '(72 . 0)
                                  '(73 . 2)
                            )
                  )
                  (entmake ent)
                )
              )
              (setq w (+ (nth j wlst) txtPlus)) ;; 調整用幅を足す
              (setq pt (list (+ (car pt) w) (cadr pt) 0.0))
              (setq j (1+ j))
            )
            (setq pt (list (car gen) (- (cadr pt) h) 0.0))
            (setq i (1+ i))
          )
          (initget "Yes No")
          (if (not (setq kw (getkword "\n区切り線を描きますか？[Yes/No] <Y> : "))) 
            (setq kw "Yes")
          )
          (if (= kw "Yes") 
            (progn 
              (setq pt (list (- (car gen) (* txtH txtXOf)) 
                             (+ (cadr gen) (/ h 2.0))
                       )
              )
              (setq j  0
                    ww 0
              )
              (repeat (length wlst) 
                (setq ww (+ ww (+ (nth j wlst) txtPlus)))
                (setq j (1+ j))
              )
              (setq hh (* rowcount h))
              ;; 横線)
              (repeat (+ rowcount 1) 
                (setq ent (list '(0 . "LINE") 
                                (cons 8 lay)
                                (cons 10 pt)
                                (cons 11 (list (+ (car pt) ww) (cadr pt)))
                          )
                )
                (entmake ent)
                (setq pt (list (car pt) (- (cadr pt) h)))
              )
              (setq pt (list (- (car gen) (* txtH txtXOf)) 
                             (+ (cadr gen) (/ h 2.0))
                       )
              )
              (setq j 0)
              (repeat (+ colcount 1) 
                (setq ent (list '(0 . "LINE") 
                                (cons 8 lay)
                                (cons 10 pt)
                                (cons 11 (list (car pt) (- (cadr pt) hh)))
                          )
                )
                (entmake ent)
                (if (< j colcount) 
                  (progn 
                    (setq pt (list (+ (car pt) (+ (nth j wlst) txtPlus)) (cadr pt)))
                    (setq j (1+ j))
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

;; クリップボード関数（btrimvx232c.lsp より流用）
(defun _SetClipBoardText (text / htmlfile result) 
  ;; 参照 :   http://www.theswamp.org/index.php?topic=21764.0
  ;;  Caller's sole responsibility is to pass a
  ;;  text string. Anything else? Pie in face.
  ;;  Attribution: Reformatted version of
  ;;  post by XShrimp at theswamp.org.
  ;;
  ;;  See http://tinyurl.com/2ngf4r.
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'SetData
                 "Text"
                 text
               )
  )
  (vlax-release-object htmlfile)
  text
)

;; クリップボードの文字列を取得（btrimvx232c.lsp より流用）
(defun _GetClipBoardText (/ htmlfile result) 
  ;;  Attribution: Reformatted version of
  ;;  post by Patrick_35 at theswamp.org.
  ;;
  ;;  See http://tinyurl.com/2ngf4r.
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'GetData
                 "Text"
               )
  )
  (vlax-release-object htmlfile)
  result
)
;; クリップボードの文字列をクリア（btrimvx232c.lsp より流用）
(defun _ClearClipBoardText (/ htmlfile result) 
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'ClearData
                 "Text"
               )
  )
  (vlax-release-object htmlfile)
  result
)

;; クリップボードの文字列をテキストウィンドウに表示（btrimvx232c.lsp より流用）
(defun dispClipTextLst (cliplsts / i lst j s) 
  (setq i 0)
  (repeat (length cliplsts) 
    (setq lst (nth i cliplsts)
          j   0
          s   ""
    )
    (repeat (length lst) 
      (setq s (strcat s " \"" (nth j lst) "\""))
      (setq j (1+ j))
    )
    (princ s)
    (princ "\n")
    (setq i (1+ i))
  )
)

;;文字列の位置を返す(1〜)（btrimvx232c.lsp より流用）
(defun ifs_strpos (des src / res n m cnt i loop) 
  (setq res 0)
  (setq n    (strlen src)
        m    (strlen des)
        i    1
        loop T
        cnt  (1+ (- n m))
  )
  (while (and (>= cnt i) loop) 
    (if (equal (substr src i m) des) 
      (setq loop nil
            res  i
      )
      (setq i (1+ i))
    )
  )
  res ;
)
(prompt "\nTXHUP.lsp 2026.02.08 ロードされました.")
(princ)