;等高線に標高を設定

;<-----20251101
;<-----20250820
;<-----20250801
;<-----20250715




  ;+++++++++++++無限ループ
  (defun C:ContourZn (/ Ent);
  ;+++++++++++++
    (while T;無限ループ
      (SubContourZn)
    )
    (princ)
  );+++++++++++++



  ;------------等高線を個々に選択し、標高値を入力--->Z画層を設定
  (defun SubContourZn (/ Ent);単独/個々
  ;------------
    (setq Ent (entget (car (entsel "<等高線を選択>:")))) ;EntにDXF図形情報のリストを代入
    (if (= (cdr (assoc 0 Ent)) "LWPOLYLINE") ;選択図形がポリラインかどうかチェック
      (progn ;図形がポリラインの時の処理
        ;---------------------標高値
        (if (Getenv "標高値")
              (setq 標高値 (getstring 
                        (strcat "\n[標高値を入力]<" (itoa (atoi (getenv "標高値")))">:")))
              (setq 標高値 (getstring 
                        (strcat "\n[標高値を入力]< >:"))))
        (if (= "" 標高値)
          (setq 標高値 (Getenv "標高値")));Enter/空打--->従前値採用
        ;------------
        (if (not(= 標高値 nil));標高値が入力されたとき
          (progn ;処理
            (setq 標高値 (itoa (atoi 標高値)))
            ;---------------------
            (setq MyColor (Getenv "MyColor"));色番号
            (setq NewLayer (Strcat  "Z" 標高値))
            ;--------------------------
            (Command "OsnapCoord" "1" 
                        "-Layer" "M" NewLayer "C" MyColor NewLayer ""
            )
            ;--------------------------;画層名
            (Setq  NewEnt (Strcat  "Z" 標高値))
            (setq Ent ;書き直したDXF図形情報のリストをEntに入れ直し
              (subst ;入れ替える
                  (cons 8 NewEnt) ; 新しい値
                  (assoc 8 Ent) ; 古い値
              Ent) ;Entに入っているDXF図形情報のリストを      
            );setq
            ;--------------------------;色番号
            (setq Ent ;書き直したDXF図形情報のリストをEntに入れ直し
              (subst ;入れ替える
                  (cons 62 256) ; ByLayer 新しい値
                  (assoc 62 Ent) ; 古い値
              Ent) ;Entに入っているDXF図形情報のリストを    
            );setq
            (entmod Ent) ;DXF図形情報を図形に反映
            ;------------
            (Command "OsnapCoord" "1" "-Layer" "M" "LayerCheck"  "P" "N" "" "")
            (setq npsu (cdr (assoc 90 Ent)));頂点数
            (setq Znn (cdr (assoc 8 Ent)));画層名
            (setq pstl Ent)
            (setq nc 0)
            
            (repeat npsu
              (setq Pt (cdr (assoc 10 pstl)));LWPOLYLINEの頂点座標を取得
              (setq Pt (trans Pt  MyEnt 0));OCS座標からWCS座標に変換
              (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
              ;+++++++++++++
              (setq PtX (car Pt)
                    PtY (cadr Pt))
              (setq PtX (rtos PtX )
                    PtY (rtos PtY ))
              ;+++++++++++++	
              (setq Pt (Strcat PtX "," PtY))
              (if (or (= nc 0)(= nc (1- npsu)));両端点 
                  (Command "ID" Pt 
                          "Ucs" "w" "-MText" "@" "J" "MC" "@0,0" Znn ""
                          "Ucs" "p")
              );if
              (setq ppnl (assoc 10 pstl))
              (setq pstl (member ppnl pstl))
              (setq pstl (cdr pstl))
              (if (= nc 0)
                  (setq lppnt (list ppnt))
                  (setq lppnt (append lppnt (list ppnt)))
              );if
              (setq nc (+ nc 1))
            );repeat
            ;------------
            (if (getenv "⊿")
              (progn ;処理
                  (setq Zp (+ (atof (getenv "⊿")) (atof 標高値)))	
                  (setEnv "標高値" (rtos Zp))	
              )
              (setenv "標高値" 標高値);
            )
          );progn
        );if 
      );progn
      (alert "選択エラー：等高線を選択して下さい。") ;図形がポリライン以外の時、
                                                  ;メッセージボックスを表示;Else
    );if
    (princ)
  );------------










  ;
  ;+++++++++++++等高線を一括選択し、標高値を入力--->Z画層を設定
  (defun C:ContourZnMulti (/ Ent);一括選択
  ;+++++++++++++
    (princ "\n<等高線を選択>：")
    (setq Obj (ssget (list 
          (cons -4 "<OR")
          (cons 0 "LWPOLYLINE")
          (cons 0 "POLYLINE")
          (cons -4 "OR>")
    )));list-ssget-setq
    
    (if (not(= Obj nil));ポリライン（LWPOLYLINE/POLYLINE）が選択されたら・・・
      (progn
        (setq cnt 0)
        (setq num (sslength Obj))
        (setq DataList nil)
        ;---------------------
        (while (< cnt num)
          (setq MyEnt (ssname Obj cnt))
          (setq Ent (entget MyEnt))
          (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
          (setq DataList (cons MyHandle DataList))
          (setq cnt (1+ cnt))
        );while
        (Command "Grips" "2")
        ;---------------------
        (setq cnt 0)
        (while (< cnt num)
          (setq MyHandle (nth cnt DataList))
          (command "select" (handent MyHandle))
          ;---------------------標高値
          (setq 標高値 (getstring (strcat "\n[標高値を入力]< >:")))
          ;)
          (if (= "" 標高値)
            (setq 標高値 nil)
            (progn
              (if (not(= 標高値 nil));
                (progn ;標高値が入力されたとき
                  (setq 標高値 (itoa(atoi 標高値)))
                  (Setenv "標高値" 標高値);
                  ;---------------------色番号
                  (setq MyColor (Getenv "MyColor"));色番号
                  (setq NewLayer (Strcat  "Z" 標高値))
                  ;--------------------------
                  (Command "" "Grips" "2" 
                      "-Layer" "M" NewLayer "C" MyColor NewLayer "" "Grips" "2"  )
                  (command "_Laycur" (handent MyHandle)  "" )
                  (command "" "Grips" "2")
                );progn
              );if
            );progn
          );if
          (command "Grips" "2")
          (setq 標高値 nil)
          ;------------
          (Command "OsnapCoord" "1" "-Layer" "M" "LayerCheck"  "P" "N" "" "")

          (setq Ent (entget (handent MyHandle)))
          ;(setq MyEnt (ssname Obj cnt)
                    ;Ent (entget MyEnt))
          ;------------
          (setq npsu (cdr (assoc 90 Ent)));頂点数
          (setq Znn (cdr (assoc 8 Ent)));画層名
          (setq pstl Ent)
          (setq nc 0)
        
          (repeat npsu
            (setq Pt (cdr (assoc 10 pstl)));LWPOLYLINEの頂点座標を取得
            (setq Pt (trans Pt  MyEnt 0));OCS座標からWCS座標に変換
            (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
            ;+++++++++++++
            (setq PtX (car Pt)
                  PtY (cadr Pt))
            (setq PtX (rtos PtX )
                  PtY (rtos PtY ))
            ;+++++++++++++	
            (setq Pt (Strcat PtX "," PtY))
            (if (or (= nc 0)(= nc (1- npsu)));両端点 
              (Command "ID" Pt 
                        "Ucs" "w" "-MText" "@" "J" "MC" "@0,0" Znn ""
                        "Ucs" "p")
            );if
            (setq ppnl (assoc 10 pstl))
            (setq pstl (member ppnl pstl))
            (setq pstl (cdr pstl))
            (if (= nc 0)
              (setq lppnt (list ppnt))
              (setq lppnt (append lppnt (list ppnt)))
            );if
            (setq nc (+ nc 1))
          );repeat
      
          (setq cnt (1+ cnt))
        );while
        (command "Grips" "2")
      );progn
      ;文字列（LWPOLYLINE/POLYLINE）が選択されなかったら・・・
      (alert "選択エラー：等高線（LWPOLYLINE/POLYLINE）が選択されていません") 
    );if
    (princ)
  );+++++++++++++








  ;+++++++++++++色番号
  (defun C:ColorPalette (/ Ent);
  ;+++++++++++++
    (if (Getenv "MyColor")
      (setq MyColor (getstring (strcat 
              "\n[1:赤/2:黄/3:緑/4:水色/5:青/6:紫/7:黒/8:濃灰/9:淡灰]<" (Getenv "MyColor") ">:")))
      (setq MyColor (getstring (strcat 
              "\n[1:赤/2:黄/3:緑/4:水色/5:青/6:紫/7:黒/8:濃灰/9:淡灰]< >:"))))
    (if (= "" MyColor)
      (setq MyColor (Getenv "MyColor")));Enter/空打--->従前値採用
    (Setenv "MyColor" MyColor);
    (princ)
  );+++++++++++++












