;2Dポリライン等高線の頂点座標(x,y)をcsvファイル出力(Contour2DXYZ.lsp)

;(R)=ARES
;Nov.01-2025
;Aug.28-2024
;Jul.01-2024


;************************** 
(defun C:csvExportPoly2D ( / Obj num)
;**************************
;テキストファイルを書き出す
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/ContourXYZ.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n****  等高線を選択  ****")
      (setq Obj(ssget (list (cons 0 "LWPOLYLINE"))))
      (setq cnt 0)
      (setq num (sslength Obj))
      ;-----------
      (while (< cnt num);
        (setq MyEnt (ssname Obj cnt))
        (setq Ent (entget MyEnt))
        (if (= (cdr (assoc 0 ent)) "LWPOLYLINE") ;選択図形が最適化ポリライン
          (progn ;図形が最適化ポリラインの時、処理
            (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 (Atof (Getenv "係数")))))
              (setq PtY (rtos (* PtY (Atof (Getenv "係数")))))
              ;+++++小数点揃え
              (setq PtX (rtos (Atof PtX) 2 (Atoi (Getenv "小数点"))))
              (setq PtY (rtos (Atof PtY) 2 (Atoi (Getenv "小数点"))))
              ;+++++
              (setq PtZ (substr Znn 2));
              ;(setq Pt (Strcat (cnt "," PtX "," PtY "," PtZ))
              (setq Pt (Strcat (itoa cnt) "," PtX "," PtY "," PtZ))
              ;+++++++++++++++++++++++++++++
              (write-line Pt FileID) 
              ;+++++++++++++++++++++++++++++                    
              (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	
          );progn	
        );if
        (setq cnt (1+ cnt))
      );while	
      ;----------------
      (close FileID)
	    (StartApp "C:/MyCANAL/Supply/App/App_Mkcsv-R.exe")
    );progn
    (alert "\n   ***** ファイルが見当たりません *****") ;エラーメッセージ 
  );if
  (princ)
);defun



;選択したポリラインの画層名を両端に表記
;************************** 
(defun C:LayerCheck ( / Obj cnt num MyEnt ed PtX PtY Pt )
;************************** 
  (princ "\n****  等高線を選択  ****")
  (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
  ;------------
  (if (not(= Obj nil));最適化ポリラインが選択されていたら・・・
    (progn
      (setq cnt 0
            num (sslength Obj))
      ;------------
      (Command "OsnapCoord" "1" "-Layer" "M" "LayerCheck"  "P" "N" "" "")
      ;------------
      (while (< cnt num);
        (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
    );progn
    ;最適化ポリラインが選択されていなかったら・・・
    (alert "選択エラー：最適化ポリラインが選択されていません") 
  ):if
  (princ)
)




