;;AUTOCAD 2000i/icad mj2b.lsp 01/03/30 Atsuhiro Kawasaki
;文字列を２分割 ／ スライダーの練習

(defun c:mj2b ( / mlist elist f tx1 len)                                   ;メインルーチンの始まり
 (setq f T)                                                                ;ループフラグfを初期化
 (while f                                                                  ;fがnilでなければ繰り返す
  (setq f (entsel "\n/\nTEXT文字列を選択してください。 <中止>:"))          ;ユーザーによる文字列の選択 f=(<図形名> 座標リスト)
  (if (not f) (progn (princ "\n無選択／中止。")(exit)))                    ;選択が無効なら中断
  (setq
   elist (entget (car f))                                                  ;選択図形の属性リストelistを取得
   f (cdr (assoc '0 elist))                                                ;f=図形タイプ "text" "line"
   ) 
  (if (= f "TEXT") (setq f nil))                                           ;fが"text"ならループを打ち切る
 );en-wl                                                                   ;whileの終わり
 (setq tx1 (cdr (assoc '1 elist)))                                         ;文字列tx1
 (dvtx tx1)                                                                ;表示用リストmlistと文字数len
 (mkdcl len (strlen tx1) 1)                                                ;dclファイルを作成
 (dial mlist)                                                              ;ダイアログで作業
 (mkdcl 0 0 0)                                                             ;dclファイルを無効に
 (princ)                                                                   ;サイレントエンド
);en-fn                                                                    ;メインルーチンの終わり

;DVTX:文字列mmから半角全角を区別して全部の分割数に対する分割文字リストmlistと文字数lenを作成する

(defun dvtx (mm / a st i)                                                  ;サブルーチンの始まり
 (setq mlist (list (cons 0 (list "" mm))) i 1)                             ;分割位置0=初期値の場合を作る カウントiを初期化
 (while mm                                                                 ;文字列mmがnilでないなら繰り返す mm="abc"
  (setq a (ascii mm))                                                      ;文字列の先頭文字のアスキーコードを取る
  (if
   (or
    (and (> a 31) (< a 127))                                               ;アスキーコードが31以上127以下の場合
    (and (> a 160) (< a 224))                                              ;あるいは160以上224以下
   )
   (setq a 1)                                                              ;ならば 半角     a=1
   (setq a 2)                                                              ;でないなら 全角 a=2
   )
  (setq
   st (substr mm 1 a)                                                      ;先頭aバイトの文字 "a"
   mm (substr mm (1+ a))                                                   ;最初の文字を削除  "bc"
   mlist                                                                   ;mlist=((3."abc" "")(2."ab" "c")(1."a" "bc")(0. "" "abc"))となる
   (cons                                                                   ;リストの先頭に項目追加
    (cons                                                                  ;ペアリストを作成 (i.xx)
     i                                                                     ;ペアリストの親
     (list                                                                 ;子リスト作成
      (strcat (car (cdr (car mlist))) st)                                  ;前回mlist値の第一文字列に今回stを加える
      mm                                                                   ;残りの文字mm
     );en-li                                                               ;子リストの終わり
    );en-co                                                                ;ペアリストの終わり
    mlist                                                                  ;前回までのリスト
   );en-co                                                                 ;consの終わり
  );en-sq
  (if (= mm "")                                                            ;mmが""なら
   (setq mm nil)                                                           ;ループを打ち切り
   (setq i (1+ i))                                                         ;でないならカウントアップ
  )
 );en-wl                                                                   ;whileの終わり
 (setq len i)                                                              ;カウンタiをlenに代入
);en-fn                                                                    ;サブルーチンの終わり

;DIAL;ダイアログの表示とスライダー値の変更および文字配置 ml=表示用文字リスト

(defun dial (ml / slider_pos diag_stat tmpf pt1 mj newlist)                 ;サブルーチンの始まり
 (setq                                                                      ;変数の初期化
  diag_stat 4                                                               ;ダイアログの状態値 初期値4
  slider_pos 0                                                              ;スライダーの位置   初期値0
  tmpf (tmpfilen)                                                           ;dclファイルの名前 
 )
 (while (> diag_stat 1)                                                     ;ダイアログの状態が 1=ok 0=cansel以外なら繰り返す
  (setq dcl_id (load_dialog tmpf))                                          ;dclファイルをロード
  (if (not (new_dialog "mj2b" dcl_id) ) (exit))                             ;目的のダイアログ定義がなければ中止
  (set_tile "sl1" (itoa slider_pos))                                        ;スライダータイル"sl1"に値を文字でセット "1"
  (set_tile "tx1" (car (cdr (assoc slider_pos ml))))                        ;テキストタイルに第一文字列をセット (1."a" "bcd")の"a"
  (set_tile "tx2" (cadr (cdr (assoc slider_pos ml))))                       ;テキストタイルに第二文字列をセット (1."a" "bcd")の"bcd"
   (action_tile "sl1"                                                       ;スライダー値が変化したら以下""内実行
    (strcat                                                                 ;文字列の連結
    "(progn"                                                                ;複数行の実行
    "(setq slider_pos (read (get_tile \"sl1\")))"                           ;スライダー値を数値として取りこむ slider_pos=2
    "(set_tile \"tx1\" (car (cdr (assoc slider_pos ml))))"                  ;第一文字列をセット
    "(set_tile \"tx2\" (cadr (cdr (assoc slider_pos ml))))"                 ;第二文字列をセット
    ")"                                                                     ;prognの終わり
   ));en-sc-act                                                             ;strcatの終わりaction_tileの終わり
   (action_tile "bu1" "(done_dialog 2)")                                    ;配置ボタン１が押されたらダイアログの状態値=2でダイアログ中断
   (action_tile "bu2" "(done_dialog 3)")                                    ;配置ボタン２が押されたらダイアログの状態値=3でダイアログ中断
   (action_tile "accept" "(done_dialog)")                                   ;"ok"ボタンが押されたらダイアログ終了状態値=0
  (setq diag_stat (start_dialog))                                           ;ダイアログの開始 diag_statにはdone_dialogの返り値が入る
  (unload_dialog dcl_id)                                                    ;ダイアログのアンロード
  (if (> diag_stat 1)                                                       ;ダイアログの状態値が1以上=配置処理実行ならprogn以下実行。
   (progn
    (setq
     mj (nth (- diag_stat 2) (cdr (assoc slider_pos ml)))                   ;配置する文字mjをスライダー値と表示リストから取得
     pt1 (if (/= mj "") (getpoint "\n配置点を入力:"))                       ;新しい配置点をユーザーが入力
    )
    (print pt1)(princ "\n/")
    (if (and pt1 (/= mj ""))                                                ;配置点があり、文字があればprogn以下実行
     (progn
      (setq
       newlist (cons (assoc '0 elist) (cdr (member (assoc '5 elist) elist)));元属性リストから図形名を外してnewlistとする
       newlist (subst (cons 10 pt1) (assoc '10 elist) newlist)              ;配置点10を新しい点とすりかえる
       newlist (subst (cons 1 mj) (assoc '1 elist) newlist)                 ;文字内容1を新しい文字とすりかえる
      )
      (entmake newlist)                                                     ;新しい文字をentmakeで発生させる
      (redraw)                                                              ;図形再表示    
    ));en-pg-if 
  ));en-pg-if
 );en-wl                                                                    ;whileの終わり
);en-fn                                                                     ;サブルーチンの終わり

;TMPFILEN:dclファイルの名前を決める。ファイルはテンポラリフォルダに作られる。

(defun tmpfilen () (strcat (getvar "tempprefix") "mj2b.txt"))

;MKDCL:dclテキストファイルの内容をファイルtmpfに書き込む。stl=文字数 len=半角字数 job=0なら空白を書き込む

(defun mkdcl (stl len job / tmpf mf)
 (setq
  tmpf (tmpfilen)                                                           ;dclファイル名
  mf (OPEN tmpf "w")                                                        ;ファイルを書き込み属性で開く
 )
 (if (= job 1)                                                              ;job=1ならdcl内容を書き込み 0なら空白を書き込み
   (progn
    (write-line (strcat "mj2b:dialog{width=" (itoa len) "\;") mf)
    (write-line (strcat "label=\"文字列分割      文字数：" (itoa stl) "\"\;") mf)
    (write-line ":button{label=\"配置1\"\;key=\"bu1\"\;fixed_width=true\;}" mf)
    (write-line ":boxed_row{label=\"第1字列\"\;" mf)
    (write-line ":text{alignment=left\;key=\"tx1\"\;}}" mf)
    (write-line "sub_slider_1\;:boxed_row{label=\"第2字列\"\;" mf)
    (write-line ":text{alignment=left\;key=\"tx2\"\;}}" mf)
    (write-line ":button{label=\"配置2\"\;key=\"bu2\"\;fixed_width=true\;}ok_only\;}" mf)
    (write-line (strcat "sub_slider_1:slider{min_value=0\;max_value=" (itoa stl) "\;") mf)
    (write-line "big_increment=1\;small_increment=1\;key=\"sl1\"\;}" mf)
   );en-pg
    (write-line " " mf)
  );en-if
 (close mf)                                                                 ;ファイルを閉じる
);en-fn

(princ "\n文字列を２分割:コマンドは MJ2B です。")(princ)