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

;(R)=ARES

;Aug.28-2024


;************************** 
(defun C:csvExportPoly3D ( / Obj num)
;**************************
;テキストファイルを書き出す
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/ContourXYZ.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n****  等高線を選択  ****")

      ;(setq Obj(ssget (list (cons 0 "LWPOLYLINE"))))

      (setq Obj (ssget (list (cons -4 "<OR")
         (cons 0 "LWPOLYLINE")
         (cons 0 "POLYLINE")
         (cons -4 "OR>")
      )));list-ssget-setq

      (setq cnt 0)
      (setq num (sslength Obj))
      ;-----------
      (while (< cnt num);
        (setq tmpl (Ssname Obj cnt))
        (setq ent (Entget tmpl))
        (if (= (cdr (assoc 0 ent)) "LWPOLYLINE") ;選択図形が最適化ポリライン
          (progn ;図形が最適化ポリラインの時、処理
            (setq npsu (cdr (assoc 90 ent)));頂点数
            (setq PtZ (rtos (cdr (assoc 38 ent))));高度
;(alert PtZ)
            (setq pstl ent)
            (setq nc 0)
            (repeat npsu
              (setq Pt (cdr (assoc 10 pstl)));LWPOLYLINEの頂点座標を取得
              (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換
              (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
              ;+++++素地                            
              ;(setq PtX (car Pt) PtY (cadr Pt) PtZ (caddr Pt))
              (setq PtX (car Pt) PtY (cadr Pt) )
              ;+++++作図単位による調整
              (setq PtX (rtos (* PtX (Atof (Getenv "係数")))))
              (setq PtY (rtos (* PtY (Atof (Getenv "係数")))))
              ;(setq PtZ (rtos (* PtZ (Atof (Getenv "係数")))))
              ;+++++小数点揃え
              (setq PtX (rtos (Atof PtX) 2 (Atoi (Getenv "小数点"))))
              (setq PtY (rtos (Atof PtY) 2 (Atoi (Getenv "小数点"))))
              ;(setq PtZ (rtos (Atof PtZ) 2 (Atoi (Getenv "小数点"))))
              ;+++++
              ;(setq PtZ (substr Znn 2));
              ;(setq PtZ (Atof PtZ));              
              ;(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)
    );progn
    (alert "\n   ***** ファイルが見当たりません *****") ;エラーメッセージ 
  );if
  (princ)
);defun







