[AutoLISP x ChatGPT] 3Dポリラインの頂点座標をエクセルに出力する

AutoLisp
2026.01.30

こんにちは、ISDです。

私は、3Dモデリング時には3Dポリラインを使う機会が多いです。
3Dポリラインの頂点座標を確認したい時は、プロパティパレットから各頂点の座標を見ることが可能ではありますが、選択された頂点の座標しか表示されません。

これは不便だし、頂点を選択するのも面倒です。
それなりにストレスです。

3Dポリラインの頂点座標をリストで見れたら作業効率上がると思いませんか？

というわけで、3Dポリラインの頂点座標を Excel に出力してみましょう。

ChatGPTでオリジナルコマンドを作成する

では、ChatGPT にお願いしてみようと思います。

コマンドの概要は以下の通りとします。

「選択した１つの3Dポリラインの各頂点のXYZ座標をEXCELのワークシートに書き出す。」

  • EXCEL が起動してなければ、新たに起動する。
  • 書き出す対象のシート名は”3DPL_頂点座標”、なければ新たに作成する。
  • 3Dポリラインの頂点の座標を順番に１行ずつ書き出す
  • 頂点のX座標を Aの列、Y座標を Bの列、Z座標を Cの列に書き出す

コマンドの概要の他に、
デバッグが行いやすいように要所にログを仕込むのと、
AutoLISPのコードを書く際にChatGPTがやらかしそうなことを予防するため、あらかじめクギを刺しておくことにします。

では、ChatGPTにプロンプトを投げます。


AutoCADで 以下の仕様のオリジナルコマンドを作成したい。
使用言語はAutolisp

### コマンドの概要
選択した１つの3Dポリラインの各頂点のXYZ座標をEXCELのワークシートに書き出す。
・EXCEL が起動してなければ、新たに起動する。
・書き出す対象のシート名は”3DPL_頂点座標”、なければ新たに作成する。
・3Dポリラインの頂点の座標を順番に１行ずつ書き出す
・頂点のX座標を Aの列、Y座標を Bの列、Z座標を Cの列に書き出す
・デバッグが行いやすいように、要所でログを書きだす。

### AutoLISP 禁則事項
以下は必ず守ること。
・予約定数に代入しない【厳禁】
　　t / T / nil / NIL / pi / PIなど
・組み込み関数名を変数名に使わない
　　if, list, car, cdr, min, max, command, entget, vlax-* など

そして、ChatGPTの返答がこちら

以下に、指定仕様どおりの AutoLISP コマンド一式を提示します。
（※ これまでの「安定するExcel操作の型」＝ get-or-create / Worksheets→Item→Activate / Value2 + Variant / releaseはif を踏襲）

コマンド：3DPLVTX2XLS

  • 選択した 1本の3Dポリラインの各頂点XYZを Excel に書き出し
  • シート名：3DPL_頂点座標（無ければ作成）
  • A列=X, B列=Y, C列=Z
  • 要所でログ出力（コマンドラインに表示）
(vl-load-com)

;; ----------------------------
;; logger
;; ----------------------------
(defun _3dplvtx2xls-log (msg)
  (princ (strcat "\n[3DPLVTX2XLS] " msg))
)

;; ----------------------------
;; Excel起動/取得 + ブック確保
;; ----------------------------
(defun _3dplvtx2xls-ensure-excel ( / app books wb cnt)
  (_3dplvtx2xls-log "Excel Application 取得/起動...")
  (setq app (vlax-get-or-create-object "Excel.Application"))
  (vlax-put-property app 'Visible :vlax-true)

  (setq books (vlax-get-property app 'Workbooks))
  (setq cnt (vlax-get-property books 'Count))
  (_3dplvtx2xls-log (strcat "Workbooks count = " (itoa cnt)))

  ;; 開いているブックが無ければ新規作成
  (if (= cnt 0)
    (progn
      (_3dplvtx2xls-log "開いているブックが無いので新規作成(Add).")
      (setq wb (vlax-invoke-method books 'Add))
    )
    (progn
      (_3dplvtx2xls-log "ActiveWorkbook を使用します.")
      (setq wb (vlax-get-property app 'ActiveWorkbook))
      (if (null wb)
        (progn
          (_3dplvtx2xls-log "ActiveWorkbook が取れないため新規作成(Add).")
          (setq wb (vlax-invoke-method books 'Add))
        )
      )
    )
  )

  (list app books wb)
)

;; ----------------------------
;; シート取得（なければ作成）
;; - Worksheets コレクションを走査して Name一致を探す
;; - 無ければ Add して Name を設定
;; - Activate → ActiveSheet を取り直す（安定化）
;; ----------------------------
(defun _3dplvtx2xls-get-or-add-sheet (app wb targetName / wss cnt idx ws found)
  (setq wss (vlax-get-property wb 'Worksheets))
  (setq cnt (vlax-get-property wss 'Count))
  (_3dplvtx2xls-log (strcat "Worksheets count = " (itoa cnt)))

  (setq found nil)
  (setq idx 1)
  (while (and (<= idx cnt) (null found))
    (setq ws (vlax-get-property wss 'Item idx))
    (if (= (vlax-get-property ws 'Name) targetName)
      (setq found ws)
      (vlax-release-object ws)
    )
    (setq idx (1+ idx))
  )

  (if found
    (_3dplvtx2xls-log (strcat "既存シート発見: " targetName))
    (progn
      (_3dplvtx2xls-log (strcat "対象シート無し。新規作成: " targetName))
      (setq found (vlax-invoke-method wss 'Add))
      (vlax-put-property found 'Name targetName)
    )
  )

  ;; Activate（戻り値は使わない）→ ActiveSheet 取り直し
  (vlax-invoke-method found 'Activate)
  (vlax-release-object found) ;; ここで一旦解放してもOK（ActiveSheetを再取得するため）
  (setq ws (vlax-get-property app 'ActiveSheet))

  ;; wss は呼び出し側で release する
  (vlax-release-object wss)

  ws
)

;; ----------------------------
;; セル書き込み（Value2 + Variant）
;; ----------------------------
(defun _3dplvtx2xls-write-cell (ws row col val / cellObj)
  (setq cellObj (vlax-get-property ws 'Cells row col))
  (vlax-put-property cellObj 'Value2 (vlax-make-variant val))
  (vlax-release-object cellObj)
)

;; ----------------------------
;; 3Dポリライン頂点収集
;; - 3Dポリラインは entnext で VERTEX を辿り、(assoc 10) を拾う
;; - 戻り値: ((x y z) (x y z) ...)
;; ----------------------------
(defun _3dplvtx2xls-collect-3dpl-vertices (plEnt / e d pts p10)
  (setq pts nil)
  (setq e (entnext plEnt))
  (while e
    (setq d (entget e))
    (cond
      ((= (cdr (assoc 0 d)) "VERTEX")
        (setq p10 (cdr (assoc 10 d)))
        ;; p10 は (x y z)
        (if (and p10 (= (length p10) 3))
          (setq pts (append pts (list p10)))
        )
      )
      ((= (cdr (assoc 0 d)) "SEQEND")
        (setq e nil)
      )
    )
    (if e (setq e (entnext e)))
  )
  pts
)

(defun c:3DPLVTX2XLS
  ( /
    entPick entName vlaObj objName
    xlApp xlBooks xlBook xlSheet sheetName
    vtxList rowIdx ptX ptY ptZ
  )

  ;; ============================
  ;; Main
  ;; ============================
  (_3dplvtx2xls-log "コマンド開始")

  ;; 1) 選択
  (setq entPick (entsel "\n3Dポリラインを1つ選択: "))
  (if (null entPick)
    (progn
      (_3dplvtx2xls-log "選択がキャンセルされました。")
      (princ)
      (exit)
    )
  )
  (setq entName (car entPick))

  ;; 2) 3Dポリライン判定（VLA ObjectNameで確認）
  (setq vlaObj (vlax-ename->vla-object entName))
  (setq objName (vlax-get-property vlaObj 'ObjectName))
  (_3dplvtx2xls-log (strcat "Selected ObjectName = " objName))

  ;; ざっくり許容：AcDb3dPolyline / AcDbPolyLine3d など環境差があるので「3dpolyline を含むか」で判定
  (if (not (wcmatch (strcase objName) "*3DPOLYLINE*"))
    (progn
      (_3dplvtx2xls-log "3Dポリラインではありません。中止します。")
      (vlax-release-object vlaObj)
      (princ)
      (exit)
    )
  )

  ;; 3) 頂点収集
  (_3dplvtx2xls-log "頂点座標を収集します...")
  (setq vtxList (_3dplvtx2xls-collect-3dpl-vertices entName))
  (_3dplvtx2xls-log (strcat "頂点数 = " (itoa (length vtxList))))

  (vlax-release-object vlaObj)

  (if (or (null vtxList) (= (length vtxList) 0))
    (progn
      (_3dplvtx2xls-log "頂点が取得できませんでした。中止します。")
      (princ)
      (exit)
    )
  )

  ;; 4) Excel準備
  (setq sheetName "3DPL_頂点座標")
  (setq xlPack (_3dplvtx2xls-ensure-excel))
  (setq xlApp   (nth 0 xlPack))
  (setq xlBooks (nth 1 xlPack))
  (setq xlBook  (nth 2 xlPack))

  (_3dplvtx2xls-log (strcat "シート確保: " sheetName))
  (setq xlSheet (_3dplvtx2xls-get-or-add-sheet xlApp xlBook sheetName))

  ;; 5) 書き出し（1行ずつ）
  (_3dplvtx2xls-log "書き出し開始（A=X, B=Y, C=Z）")
  (setq rowIdx 1)
  (foreach pt vtxList
    (setq ptX (nth 0 pt))
    (setq ptY (nth 1 pt))
    (setq ptZ (nth 2 pt))

    (_3dplvtx2xls-write-cell xlSheet rowIdx 1 ptX)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 2 ptY)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 3 ptZ)

    (if (= (rem rowIdx 20) 0)
      (_3dplvtx2xls-log (strcat "  wrote row " (itoa rowIdx) "..."))
    )

    (setq rowIdx (1+ rowIdx))
  )
  (_3dplvtx2xls-log "書き出し完了")

  ;; 6) 後始末（Excelは起動したままでも、COM参照は解放）
  (if xlSheet (vlax-release-object xlSheet))
  (if xlBook  (vlax-release-object xlBook))
  (if xlBooks (vlax-release-object xlBooks))
  (if xlApp   (vlax-release-object xlApp))

  (_3dplvtx2xls-log "コマンド終了")
  (princ)
)

追加メモ（実務でよく起きる点）

  • 3Dポリライン判定は環境差があるため、ObjectName に *3DPOLYLINE* を含むかで緩めに判定しています。もしあなたの環境で別名が出るなら、その文字列に合わせて判定条件を調整します（ログに出ます）。
  • 書き出し開始行を 2 行目にしたい（1行目にヘッダ）なども、すぐ対応できます。

次の改善もすぐ入れられます：

  • 1行目に X,Y,Z ヘッダ行を自動追加
  • 書き込みを「配列一括」で高速化（大量頂点で効く）
  • 既存データを消してから書く／追記するを選べるようにする

必要なら、そのまま続けて入れます。


コードを書いてくれましたが、コマンドを実行してみたところエラーが出ました。
コマンドの実行結果のログをフィードバックします。

コマンドを実行すると、エラーが出ます。

###
コマンド: 3DPLVTX2XLS
[3DPLVTX2XLS] コマンド開始 3Dポリラインを1つ選択:
[3DPLVTX2XLS] Selected ObjectName = AcDb3dPolyline
[3DPLVTX2XLS] 頂点座標を収集します…
[3DPLVTX2XLS] 頂点数 = 4
[3DPLVTX2XLS] Excel Application 取得/起動…
[3DPLVTX2XLS] Workbooks count = 1
[3DPLVTX2XLS] ActiveWorkbook を使用します.
[3DPLVTX2XLS] シート確保: 3DPL_頂点座標
[3DPLVTX2XLS] Worksheets count = 2
[3DPLVTX2XLS] 既存シート発見: 3DPL_頂点座標
[3DPLVTX2XLS] 書き出し開始（A=X, B=Y, C=Z）; エラー: 実際のパラメータが多すぎます


ログありがとう。原因はここで確定です。

; エラー: 実際のパラメータが多すぎます

これは _3dplvtx2xls-write-cell の中で

(vlax-get-property ws 'Cells row col)

を呼んでいるのが原因です。

あなたの環境では vlax-get-property が 引数2つまでしか受けられないため、Cells(row,col) のような 添字付きプロパティ呼び出しができず「実引数が多すぎる」になります。

修正方針（安定型に統一）

あなたの環境で安定しているのは Range + Value2 + Variant なので、

  • Cells(row,col) は使わない
  • Range("A2") の形に変換して書く

これで確実に動きます。

差し替えコード（必要部分だけ）

1) 列番号→列名（A,B,C…）変換関数を追加

(defun _3dplvtx2xls-col->name (colNum / n r s)
  ;; 1->A, 2->B, ... 26->Z, 27->AA ...
  (setq n colNum)
  (setq s "")
  (while (> n 0)
    (setq r (rem (1- n) 26))
    (setq s (strcat (chr (+ 65 r)) s))
    (setq n (/ (- n r 1) 26))
  )
  s
)

2) _3dplvtx2xls-write-cell を Range 方式に差し替え

(defun _3dplvtx2xls-write-cell (ws rowNum colNum val / addr cellObj)
  (setq addr (strcat (_3dplvtx2xls-col->name colNum) (itoa rowNum)))
  (setq cellObj (vlax-get-property ws 'Range addr))
  (vlax-put-property cellObj 'Value2 (vlax-make-variant val))
  (vlax-release-object cellObj)
)

これで直る理由

  • vlax-get-property に 余計な引数を渡さない
  • 既にあなたの環境で通っている Range + Value2 + Variant に統一
  • つまり “Worksheets(1)問題” と同じ系統の制約を回避しています

追加：ログをもう少し強くしたい場合（任意）

書き込み直前に、例えば 1行目だけログを入れるとデバッグがさらに楽です：

(if (= rowIdx 1)
  (_3dplvtx2xls-log (strcat "write sample: A1=" (rtos ptX 2 6)))
)

この差し替えを入れた 全体完成版も、必要ならこちらで禁則事項を守ったまま丸ごと貼り直します。


コードの修正箇所を出してきましたが、ChatGPTのコードをコピペで修正を重ねていくと段々と収集がつかなくなるのを嫌というほど経験しているので、全体完成版とやらを出してもらいます。

全体完成版を書いてください。

了解。全体完成版（さっきの不具合＝Cells(row,col)禁止に対応して、Range(“A1”)方式に統一）を貼ります。
禁則事項も守ってあります（予約定数/組み込み関数名を変数にしない、ローカル化）。

(vl-load-com)

;; ----------------------------
;; logger
;; ----------------------------
(defun _3dplvtx2xls-log (msg)
  (princ (strcat "\n[3DPLVTX2XLS] " msg))
)

;; ----------------------------
;; Excel起動/取得 + ブック確保
;; ----------------------------
(defun _3dplvtx2xls-ensure-excel ( / app books wb wbCount)
  (_3dplvtx2xls-log "Excel Application 取得/起動...")
  (setq app (vlax-get-or-create-object "Excel.Application"))
  (vlax-put-property app 'Visible :vlax-true)

  (setq books (vlax-get-property app 'Workbooks))
  (setq wbCount (vlax-get-property books 'Count))
  (_3dplvtx2xls-log (strcat "Workbooks count = " (itoa wbCount)))

  (if (= wbCount 0)
    (progn
      (_3dplvtx2xls-log "開いているブックが無いので新規作成(Add).")
      (setq wb (vlax-invoke-method books 'Add))
    )
    (progn
      (_3dplvtx2xls-log "ActiveWorkbook を使用します.")
      (setq wb (vlax-get-property app 'ActiveWorkbook))
      (if (null wb)
        (progn
          (_3dplvtx2xls-log "ActiveWorkbook が取れないため新規作成(Add).")
          (setq wb (vlax-invoke-method books 'Add))
        )
      )
    )
  )

  (list app books wb)
)

;; ----------------------------
;; シート取得（なければ作成）
;; - Worksheets コレクション走査で Name一致を探す
;; - 無ければ Add → Name設定
;; - Activate → ActiveSheet を取り直す（安定化）
;; ----------------------------
(defun _3dplvtx2xls-get-or-add-sheet (app wb targetName / wss wsCount idx ws found)
  (setq wss (vlax-get-property wb 'Worksheets))
  (setq wsCount (vlax-get-property wss 'Count))
  (_3dplvtx2xls-log (strcat "Worksheets count = " (itoa wsCount)))

  (setq found nil)
  (setq idx 1)
  (while (and (<= idx wsCount) (null found))
    (setq ws (vlax-get-property wss 'Item idx))
    (if (= (vlax-get-property ws 'Name) targetName)
      (setq found ws)
      (vlax-release-object ws)
    )
    (setq idx (1+ idx))
  )

  (if found
    (_3dplvtx2xls-log (strcat "既存シート発見: " targetName))
    (progn
      (_3dplvtx2xls-log (strcat "対象シート無し。新規作成: " targetName))
      (setq found (vlax-invoke-method wss 'Add))
      (vlax-put-property found 'Name targetName)
    )
  )

  (vlax-invoke-method found 'Activate)

  ;; ActiveSheet を取り直す（found の戻り値/状態に依存しない）
  (setq ws (vlax-get-property app 'ActiveSheet))

  ;; 解放（wss, found は不要になる）
  (vlax-release-object wss)
  (if found (vlax-release-object found))

  ws
)

;; ----------------------------
;; 列番号→列名（1->A, 2->B, 27->AA ...）
;; ----------------------------
(defun _3dplvtx2xls-col->name (colNum / n r s)
  (setq n colNum)
  (setq s "")
  (while (> n 0)
    (setq r (rem (1- n) 26))
    (setq s (strcat (chr (+ 65 r)) s))
    (setq n (/ (- n r 1) 26))
  )
  s
)

;; ----------------------------
;; セル書き込み（Range + Value2 + Variant）
;; ※ Cells(row,col) は環境によって「実引数が多すぎる」になるため不使用
;; ----------------------------
(defun _3dplvtx2xls-write-cell (ws rowNum colNum val / addr cellObj)
  (setq addr (strcat (_3dplvtx2xls-col->name colNum) (itoa rowNum)))
  (setq cellObj (vlax-get-property ws 'Range addr))
  (vlax-put-property cellObj 'Value2 (vlax-make-variant val))
  (vlax-release-object cellObj)
)

;; ----------------------------
;; 3Dポリライン頂点収集
;; - entnext で VERTEX を辿り、(assoc 10) を拾う
;; - 戻り値: ((x y z) ...)
;; ----------------------------
(defun _3dplvtx2xls-collect-3dpl-vertices (plEnt / e ed pts p10 etype)
  (setq pts nil)
  (setq e (entnext plEnt))
  (while e
    (setq ed (entget e))
    (setq etype (cdr (assoc 0 ed)))
    (cond
      ((= etype "VERTEX")
        (setq p10 (cdr (assoc 10 ed)))
        (if (and p10 (= (length p10) 3))
          (setq pts (append pts (list p10)))
        )
      )
      ((= etype "SEQEND")
        (setq e nil)
      )
    )
    (if e (setq e (entnext e)))
  )
  pts
)

(defun c:3DPLVTX2XLS
  ( /
    entPick entName vlaObj objName
    xlPack xlApp xlBooks xlBook xlSheet sheetName
    vtxList rowIdx pt ptX ptY ptZ
  )

  ;; ============================
  ;; Main
  ;; ============================
  (_3dplvtx2xls-log "コマンド開始")

  ;; 1) 選択
  (setq entPick (entsel "\n3Dポリラインを1つ選択: "))
  (if (null entPick)
    (progn
      (_3dplvtx2xls-log "選択がキャンセルされました。")
      (princ)
      (exit)
    )
  )
  (setq entName (car entPick))

  ;; 2) 3Dポリライン判定（VLA ObjectName）
  (setq vlaObj (vlax-ename->vla-object entName))
  (setq objName (vlax-get-property vlaObj 'ObjectName))
  (_3dplvtx2xls-log (strcat "Selected ObjectName = " objName))

  (if (not (wcmatch (strcase objName) "*3DPOLYLINE*"))
    (progn
      (_3dplvtx2xls-log "3Dポリラインではありません。中止します。")
      (vlax-release-object vlaObj)
      (princ)
      (exit)
    )
  )

  ;; 3) 頂点収集
  (_3dplvtx2xls-log "頂点座標を収集します...")
  (setq vtxList (_3dplvtx2xls-collect-3dpl-vertices entName))
  (_3dplvtx2xls-log (strcat "頂点数 = " (itoa (length vtxList))))

  (vlax-release-object vlaObj)

  (if (or (null vtxList) (= (length vtxList) 0))
    (progn
      (_3dplvtx2xls-log "頂点が取得できませんでした。中止します。")
      (princ)
      (exit)
    )
  )

  ;; 4) Excel準備
  (setq sheetName "3DPL_頂点座標")
  (setq xlPack (_3dplvtx2xls-ensure-excel))
  (setq xlApp   (nth 0 xlPack))
  (setq xlBooks (nth 1 xlPack))
  (setq xlBook  (nth 2 xlPack))

  (_3dplvtx2xls-log (strcat "シート確保: " sheetName))
  (setq xlSheet (_3dplvtx2xls-get-or-add-sheet xlApp xlBook sheetName))

  ;; 5) 書き出し（1行ずつ）
  (_3dplvtx2xls-log "書き出し開始（A=X, B=Y, C=Z）")
  (setq rowIdx 1)
  (foreach pt vtxList
    (setq ptX (nth 0 pt))
    (setq ptY (nth 1 pt))
    (setq ptZ (nth 2 pt))

    (_3dplvtx2xls-write-cell xlSheet rowIdx 1 ptX)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 2 ptY)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 3 ptZ)

    (if (= (rem rowIdx 20) 0)
      (_3dplvtx2xls-log (strcat "  wrote row " (itoa rowIdx) "..."))
    )

    (setq rowIdx (1+ rowIdx))
  )
  (_3dplvtx2xls-log "書き出し完了")

  ;; 6) 後始末（COM参照だけ解放。Excel自体は表示のまま）
  (if xlSheet (vlax-release-object xlSheet))
  (if xlBook  (vlax-release-object xlBook))
  (if xlBooks (vlax-release-object xlBooks))
  (if xlApp   (vlax-release-object xlApp))

  (_3dplvtx2xls-log "コマンド終了")
  (princ)
)

この版は、あなたの環境で出た問題点を全部踏んで回避しています：

  • Worksheets 1 を vlax-get-property に渡さない（実引数多すぎ回避）
  • Cells(row,col) を使わず Range(“A1”) で統一（実引数多すぎ回避）
  • 書き込みは Value2 + vlax-make-variant（安定）

次に欲しくなりがちな拡張（必要ならすぐ追加します）

  • 1行目にヘッダ（X,Y,Z）を出す
  • 既存内容をクリアしてから書く／追記する選択
  • 途中でESC中断、進捗ログ（n行ごと）強化

どれ入れます？

さて、どうでしょうか？
早速コマンドを実行してみます。

OKですね。
Excel が起動して、3Dポリラインの頂点座標が出力されました。

コマンドのログも問題なさそうです。
こんなこともあろうかと、デバッグ情報用のログを仕込んでおいたのが功を奏したのでしょうか？

コマンドに機能を追加する

CHatGPTが
次に欲しくなりがちな拡張（必要ならすぐ追加します）
と提案しているので、折角なので

  • 1行目にヘッダ（X,Y,Z）を出す
  • 既存内容をクリアしてから書く

を追加してもらいます。

コマンドに以下の機能を追加してください。

###
・1行目にヘッダ（X,Y,Z）を出す
・既存内容をクリアしてから書く

了解。以下の2点を追加した 全体完成版です。

  • 1行目にヘッダ（X,Y,Z） を出力
  • 既存内容をクリアしてから書く（対象シートの UsedRange を Clear ）

※ 既存データのクリアは、環境差を避けるため Range/Value2 型に寄せつつ、Excel 側の UsedRange.Clear を呼びます（引数なしメソッドなので安定）。

(vl-load-com)

;; ----------------------------
;; logger
;; ----------------------------
(defun _3dplvtx2xls-log (msg)
  (princ (strcat "\n[3DPLVTX2XLS] " msg))
)

;; ----------------------------
;; Excel起動/取得 + ブック確保
;; ----------------------------
(defun _3dplvtx2xls-ensure-excel ( / app books wb wbCount)
  (_3dplvtx2xls-log "Excel Application 取得/起動...")
  (setq app (vlax-get-or-create-object "Excel.Application"))
  (vlax-put-property app 'Visible :vlax-true)

  (setq books (vlax-get-property app 'Workbooks))
  (setq wbCount (vlax-get-property books 'Count))
  (_3dplvtx2xls-log (strcat "Workbooks count = " (itoa wbCount)))

  (if (= wbCount 0)
    (progn
      (_3dplvtx2xls-log "開いているブックが無いので新規作成(Add).")
      (setq wb (vlax-invoke-method books 'Add))
    )
    (progn
      (_3dplvtx2xls-log "ActiveWorkbook を使用します.")
      (setq wb (vlax-get-property app 'ActiveWorkbook))
      (if (null wb)
        (progn
          (_3dplvtx2xls-log "ActiveWorkbook が取れないため新規作成(Add).")
          (setq wb (vlax-invoke-method books 'Add))
        )
      )
    )
  )

  (list app books wb)
)

;; ----------------------------
;; シート取得（なければ作成）
;; ----------------------------
(defun _3dplvtx2xls-get-or-add-sheet (app wb targetName / wss wsCount idx ws found)
  (setq wss (vlax-get-property wb 'Worksheets))
  (setq wsCount (vlax-get-property wss 'Count))
  (_3dplvtx2xls-log (strcat "Worksheets count = " (itoa wsCount)))

  (setq found nil)
  (setq idx 1)
  (while (and (<= idx wsCount) (null found))
    (setq ws (vlax-get-property wss 'Item idx))
    (if (= (vlax-get-property ws 'Name) targetName)
      (setq found ws)
      (vlax-release-object ws)
    )
    (setq idx (1+ idx))
  )

  (if found
    (_3dplvtx2xls-log (strcat "既存シート発見: " targetName))
    (progn
      (_3dplvtx2xls-log (strcat "対象シート無し。新規作成: " targetName))
      (setq found (vlax-invoke-method wss 'Add))
      (vlax-put-property found 'Name targetName)
    )
  )

  (vlax-invoke-method found 'Activate)
  (setq ws (vlax-get-property app 'ActiveSheet))

  (vlax-release-object wss)
  (if found (vlax-release-object found))

  ws
)

;; ----------------------------
;; シート内容クリア（UsedRange.Clear）
;; ----------------------------
(defun _3dplvtx2xls-clear-sheet (ws / ur)
  (_3dplvtx2xls-log "既存内容をクリアします（UsedRange.Clear）")
  (setq ur (vlax-get-property ws 'UsedRange))
  (vlax-invoke-method ur 'Clear)
  (vlax-release-object ur)
)

;; ----------------------------
;; 列番号→列名
;; ----------------------------
(defun _3dplvtx2xls-col->name (colNum / n r s)
  (setq n colNum)
  (setq s "")
  (while (> n 0)
    (setq r (rem (1- n) 26))
    (setq s (strcat (chr (+ 65 r)) s))
    (setq n (/ (- n r 1) 26))
  )
  s
)

;; ----------------------------
;; セル書き込み（Range + Value2 + Variant）
;; ----------------------------
(defun _3dplvtx2xls-write-cell (ws rowNum colNum val / addr cellObj)
  (setq addr (strcat (_3dplvtx2xls-col->name colNum) (itoa rowNum)))
  (setq cellObj (vlax-get-property ws 'Range addr))
  (vlax-put-property cellObj 'Value2 (vlax-make-variant val))
  (vlax-release-object cellObj)
)

;; ----------------------------
;; 3Dポリライン頂点収集
;; ----------------------------
(defun _3dplvtx2xls-collect-3dpl-vertices (plEnt / e ed pts p10 etype)
  (setq pts nil)
  (setq e (entnext plEnt))
  (while e
    (setq ed (entget e))
    (setq etype (cdr (assoc 0 ed)))
    (cond
      ((= etype "VERTEX")
        (setq p10 (cdr (assoc 10 ed)))
        (if (and p10 (= (length p10) 3))
          (setq pts (append pts (list p10)))
        )
      )
      ((= etype "SEQEND")
        (setq e nil)
      )
    )
    (if e (setq e (entnext e)))
  )
  pts
)

(defun c:3DPLVTX2XLS
  ( /
    entPick entName vlaObj objName
    xlPack xlApp xlBooks xlBook xlSheet sheetName
    vtxList rowIdx pt ptX ptY ptZ
  )

  ;; ============================
  ;; Main
  ;; ============================
  (_3dplvtx2xls-log "コマンド開始")

  ;; 1) 選択
  (setq entPick (entsel "\n3Dポリラインを1つ選択: "))
  (if (null entPick)
    (progn
      (_3dplvtx2xls-log "選択がキャンセルされました。")
      (princ)
      (exit)
    )
  )
  (setq entName (car entPick))

  ;; 2) 3Dポリライン判定
  (setq vlaObj (vlax-ename->vla-object entName))
  (setq objName (vlax-get-property vlaObj 'ObjectName))
  (_3dplvtx2xls-log (strcat "Selected ObjectName = " objName))

  (if (not (wcmatch (strcase objName) "*3DPOLYLINE*"))
    (progn
      (_3dplvtx2xls-log "3Dポリラインではありません。中止します。")
      (vlax-release-object vlaObj)
      (princ)
      (exit)
    )
  )

  ;; 3) 頂点収集
  (_3dplvtx2xls-log "頂点座標を収集します...")
  (setq vtxList (_3dplvtx2xls-collect-3dpl-vertices entName))
  (_3dplvtx2xls-log (strcat "頂点数 = " (itoa (length vtxList))))
  (vlax-release-object vlaObj)

  (if (or (null vtxList) (= (length vtxList) 0))
    (progn
      (_3dplvtx2xls-log "頂点が取得できませんでした。中止します。")
      (princ)
      (exit)
    )
  )

  ;; 4) Excel準備
  (setq sheetName "3DPL_頂点座標")
  (setq xlPack (_3dplvtx2xls-ensure-excel))
  (setq xlApp   (nth 0 xlPack))
  (setq xlBooks (nth 1 xlPack))
  (setq xlBook  (nth 2 xlPack))

  (_3dplvtx2xls-log (strcat "シート確保: " sheetName))
  (setq xlSheet (_3dplvtx2xls-get-or-add-sheet xlApp xlBook sheetName))

  ;; 5) 既存内容をクリア
  (_3dplvtx2xls-clear-sheet xlSheet)

  ;; 6) ヘッダ行
  (_3dplvtx2xls-log "ヘッダ行を書き出します（X,Y,Z）")
  (_3dplvtx2xls-write-cell xlSheet 1 1 "X")
  (_3dplvtx2xls-write-cell xlSheet 1 2 "Y")
  (_3dplvtx2xls-write-cell xlSheet 1 3 "Z")

  ;; 7) データ書き出し（2行目から）
  (_3dplvtx2xls-log "書き出し開始（2行目から / A=X, B=Y, C=Z）")
  (setq rowIdx 2)
  (foreach pt vtxList
    (setq ptX (nth 0 pt))
    (setq ptY (nth 1 pt))
    (setq ptZ (nth 2 pt))

    (_3dplvtx2xls-write-cell xlSheet rowIdx 1 ptX)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 2 ptY)
    (_3dplvtx2xls-write-cell xlSheet rowIdx 3 ptZ)

    (if (= (rem rowIdx 20) 0)
      (_3dplvtx2xls-log (strcat "  wrote row " (itoa rowIdx) "..."))
    )

    (setq rowIdx (1+ rowIdx))
  )
  (_3dplvtx2xls-log "書き出し完了")

  ;; 8) 後始末（COM参照解放）
  (if xlSheet (vlax-release-object xlSheet))
  (if xlBook  (vlax-release-object xlBook))
  (if xlBooks (vlax-release-object xlBooks))
  (if xlApp   (vlax-release-object xlApp))

  (_3dplvtx2xls-log "コマンド終了")
  (princ)
)

必要なら次に、ヘッダを太字＋列幅自動調整（AutoFit） も同じ安定型（Range経由）で追加できます。


そして、コマンドを実行してみた結果。

1行目に 、「X」「Y」「Z」のヘッダーも表示されるようになりました。

まとめ

ChatGPTを使って、3Dポリラインの頂点座標をExcel に出力する オリジナルコマンドを作成することが出来ました。
これを活用すれば、3Dポリラインの頂点座標を確認する際の作業効率が上がると思います。

ていうか、こういった3Dポリラインの頂点編集パレットは最初から標準機能で準備されてるとありがたいのですが……AUTODESKさん、お願いします！

.

コメント

タイトルとURLをコピーしました