;等高線に標高を設定

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




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



;------------
(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)
);------------











;+++++++++++++
(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)
);+++++++++++++












