[AutoLISP X ChatGPT] 3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する

AutoLisp

こんにちは、ISDです。

今回も行ってみましょう、AutoLISP x ChatGPT

3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する

さて、今回のお題はこれです。
「3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する」

地形のモデルをTINで提供されることは、よくある事です。


TINを編集したり、合成したり、構造物のモデルとの取り合いを調整したりするときに、

「TINの外縁のポリラインが欲しい」

ということが、まれに……よくあります!
しかもこの作業、地味に面倒くさいです。

あ、Civil3D で……という御意見は却下です。(落ちるし、重いし、面倒くさいし!)

という我がままのもと、
「3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する」
オリジナルコマンドを使って作成します。

実は、このコマンドも以前作ったことがあるのですが、ChatGPT で作れるか試してみたいと思います。

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

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

いつもは、ChatGPT がコマンドを作成する際のガイドとして、コマンドの仕様や大まかな作業手順(フローチャート)をプロンプトに組み込んでいます。

しかし今回は、ChatGPT がどこまでできるのか試してみたいので、作業手順の考案も含めて ChatGPT に任せてみることにします。


ChatGPT に作業手順を考えてもらう

ということで、投げたプロンプトがこちら

複数の三角ポリゴンから構成される開いたTINがあります。
TINの外縁の線分のリストを作成する手順を考えてください。

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

ここでは アルゴリズム(手順) を整理しておきます。
(実装は AutoLISP を想定した書き方にしますが、あくまで考え方です)


ゴール

  • 入力:複数の三角ポリゴン(3DFACE の集合)からなる TIN(開いたメッシュ)
  • 出力:TIN の 外縁を構成する線分のリスト
    • 「外側に面が無いエッジ」=「そのエッジを共有している三角形が1枚だけのエッジ」

全体の考え方

  1. まず、TIN のすべての三角形から 全エッジ(線分)を列挙する。
  2. 「どのエッジが何回出てきたか」を数える。
  3. 出現回数が 1回だけ のエッジが、TIN の境界(外縁+穴の縁)になる。
  4. その境界エッジを、頂点つなぎで並べ替えてポリライン化すれば「輪郭線」として扱える。

ステップ1:すべての三角面からエッジを列挙

前提:TIN は 3DFACE で、すべて三角形(4頂点目 = 3頂点目)とする。

  1. ユーザーに TIN の 3DFACE 群を選択させる(ssget '((0 . "3DFACE")))。
  2. 各 3DFACE について:
    • 頂点 v1 = DXFコード 10
    • 頂点 v2 = DXFコード 11
    • 頂点 v3 = DXFコード 12
    • (13 は無視 or 三角判定用)
  3. その三角形のエッジは 3本:
    • e1 = v1 - v2
    • e2 = v2 - v3
    • e3 = v3 - v1

これを全部集めていきます。


ステップ2:「エッジをキー化」して出現回数を数える

ポイント:エッジは無向(v1–v2 と v2–v1 は同じ) なので、
AutoLISP っぽく書くと:

  1. まず「点を文字列キー」に変換する関数を用意(前にやったやつと同じ) ;; 点 p = (x y z) を "x,y,z" 文字列にする ;; 小数第6位くらいで丸めておく (defun pt-key (p) (strcat (rtos (car p) 2 6) "," (rtos (cadr p) 2 6) "," (rtos (caddr p) 2 6) ) )
  2. エッジ用のキーを 順序付きで2通り 作る: ;; エッジ p1-p2 に対して "p1|p2" と "p2|p1" の両方を作る (defun edge-keys (p1 p2 / k1 k2) (setq k1 (pt-key p1) k2 (pt-key p2)) (list (strcat k1 "|" k2) ; key1 : p1→p2 (strcat k2 "|" k1)) ; key2 : p2→p1 )
  3. グローバル/ローカルな「エッジテーブル」的なリストを持つ:
    • edgeTab の要素イメージ: ( (key1 count1 p1 p2) (key2 count2 p3 p4) ... )
    • または Association List 的に (key . data) でも OK。
  4. 三角形から得たエッジ p1-p2 について:
    • edge-keys("p1|p2" "p2|p1") を取得
    • edgeTab を探し、どちらかのキーが既にあったら count++
    • なければ、新しく
      ("p1|p2" 1 p1 p2) のような構造を edgeTab へ追加。

こうして、「このエッジは何枚の三角形に属しているか」が count に溜まっていきます。


ステップ3:外縁エッジだけを抽出

全 3DFACE を処理し終わったら、edgeTab をなめていき:

  • 要素 (key count p1 p2) について
    count = 1 のものだけを「境界エッジ」として取り出す。
  • count = 2 → 内部で他の三角形と共有しているエッジ(TIN内部)なので外縁ではない。

これで、「TIN の境界(外周+穴の縁)を構成する線分のリスト」が手に入ります。

  • 必要なら、この時点で LINE3DPOLY を作図しても良いですし、
  • その前に ポリラインとして連結したい場合 は、次のステップへ。

ステップ4:境界エッジを並べ替えてポリライン化

境界エッジのリストは単に「バラバラの線分の集合」なので、
接続情報を使って順番に並べる と、外縁のポリラインができます。

やることはグラフのトレースです:

  1. 境界エッジごとに、
    • 始点 p1
    • 終点 p2
      を保持しておく。
  2. 「ある頂点に接続するエッジのリスト」を辞書のように持つ:
    • 例:nodeTab
      • キー:頂点キー(pt-key p
      • 値:その頂点に接続するエッジの ID またはポインタ
  3. まだ未使用のエッジからスタート:
    • currentEdge = e0
    • currentPoint = e0.p1
    • ポリラインの頂点リスト poly = ( p1, p2, ... ) を作成開始。
  4. currentPoint に接続する「未使用のエッジ」を探し、次のように進む:
    • 見つかったエッジ e1 のもう一方の端点を nextPoint とする。
    • nextPointpoly に追加。
    • e1 を「使用済み」とマーク。
    • currentPoint = nextPoint として繰り返し。
  5. 次のどちらかになったら、そのチェーンは終了:
    • 戻ってきて最初の点に着いた(閉じたポリライン)。
    • もう接続する未使用エッジが無い(開いた線の端)。
  6. 未使用エッジがまだあれば、別のチェーン(別の輪郭)として 3〜5 を繰り返す。

こうして、境界線は

  • 複数の閉じたループ(外周+内側の穴の輪郭)
  • または開いた境界線(完全に閉じていない TIN の端)
    として分解されます。

外縁(最も外側の境界)だけを欲しい場合

上の手順で得られた「境界ポリライン」が複数あるとき:

  • 各ポリラインの
    • 全長を計算して、最大のものを「外縁」とみなす
      → 穴を含んでいる場合、大きいループが外周になることが多い
  • あるいは
    • 中心座標の Z が低い/高いなど、別の基準で判定することも可能

TIN の形状次第ですが、一般的には「一番長いループ=外周」となるケースが多いです。


まとめ(手順だけおさらい)

  1. すべての三角 3DFACE を走査し、各面から 3 本のエッジを取り出す。
  2. 各エッジを「順不同のキー」で管理しながら、出現回数をカウントする。
  3. 出現回数が 1 回だけのエッジを「境界エッジ」としてリストアップする。
  4. 境界エッジ同士を頂点の接続関係でたどり、ポリライン(輪郭)として並べる。
  5. 必要なら、その中から最大ループだけを選んで「外縁」とする。

もし「この手順をベースにして、実際に動く AutoLISP コードまで書いてほしい」という場合は、

  • 3DFACE → エッジテーブル作成部
  • エッジカウント部
  • 境界線ポリライン作図部

まで一気に書き切る形のサンプルも用意できます。

ふ~む、問題なさそうです。

フローや、外縁のエッジを抽出するアルゴリズムは私が過去に作成したコマンドと ほぼ同じです。

では、先に進めましょう。

AutoLISP のコードを書いてもらう

次に投げたプロンプトがこちら

この手順をベースにして、実際に動く AutoLISP コードまで書いてほしい

### 追記
・輪郭線は3Dポリラインで生成する。
・複数の輪郭線がある場合は、全ての輪郭線を生成する。

ちょっと、仕様を足しました。
ChatGPT の返答がこちら

じゃあ、その手順をそのままコードに落としてみますね。
TIN(三角 3DFACE 群)から 外縁の3Dポリラインを全部作るコマンドです。


コマンド仕様

  • コマンド名:TINBND
  • 対象:3DFACE(主に三角面。四角面が混じっていてもOK)
  • 処理内容:
    1. 選択した 3DFACE から全エッジを列挙
    2. 共有回数をカウントして、1回だけ現れるエッジ=境界エッジを抽出
    3. 境界エッジをつないで 3Dポリライン(閉じた輪郭/開いた輪郭) を全部生成
  • ポリラインは 各エッジの元の3DFACEと同じレイヤ に作成します
    (輪郭がまたがっている場合は、最初のエッジのレイヤになります)

ソースコード(AutoLISP)

;;;---------------------------------------------
;;; TIN の境界線を 3Dポリラインとして生成
;;; コマンド名:TINBND
;;;---------------------------------------------

(defun c:TINBND ( / ss i ent ed lay v1 v2 v3 v4 edges bEdges)

  ;;-----------------------------------------
  ;; 2D点なら z=0 を付けて3Dにする安全策
  ;;-----------------------------------------
  (defun fix-pt (pt)
    (cond
      ((= (length pt) 2) (list (car pt) (cadr pt) 0.0))
      ((= (length pt) 3) pt)
      (T (list 0.0 0.0 0.0))
    )
  )

  ;;-----------------------------------------
  ;; 境界判定用の点比較(許容差付き)
  ;;-----------------------------------------
  (defun pt-equal (p1 p2 / tol)
    (setq tol 1e-8)
    (and (equal (car   p1) (car   p2) tol)
         (equal (cadr  p1) (cadr  p2) tol)
         (equal (caddr p1) (caddr p2) tol))
  )

  ;;-----------------------------------------
  ;; エッジリストにエッジを追加(共有回数カウント)
  ;; edges の要素は (p1 p2 lay cnt)
  ;; p1-p2 と p2-p1 は同じエッジとしてカウント
  ;;-----------------------------------------
  (defun add-edge (p1 p2 lay edges / e newEdges found)
    (setq p1 (fix-pt p1)
          p2 (fix-pt p2)
          newEdges nil
          found nil)
    (while edges
      (setq e (car edges))
      (if (and (null found)
               (or (and (pt-equal p1 (car e)) (pt-equal p2 (cadr e)))
                   (and (pt-equal p1 (cadr e)) (pt-equal p2 (car e)))))
        (progn
          ;; 共有回数を +1
          (setq e (list (car e) (cadr e) (caddr e) (1+ (cadddr e))))
          (setq found T)
        )
      )
      (setq newEdges (cons e newEdges))
      (setq edges (cdr edges))
    )
    ;; 見つからなければ新規エッジとして追加
    (if (not found)
      (setq newEdges (cons (list p1 p2 lay 1) newEdges))
    )
    (reverse newEdges)
  )

  ;;-----------------------------------------
  ;; リストの最後の要素(点)を取り出す
  ;;-----------------------------------------
  (defun lastpt (lst)
    (car (last lst))
  )

  ;;-----------------------------------------
  ;; 指定の点 pt と接続するエッジを
  ;; bEdges から1本だけ取り出しつつ削除
  ;; bEdges の要素は (p1 p2 lay)
  ;; 戻り値:(list 見つかったエッジ 新しいbEdges)
  ;;-----------------------------------------
  (defun take-connected-edge (pt bEdges / e head found tail)
    (setq head nil
          found nil
          tail  nil)
    (while (and bEdges (null found))
      (setq e (car bEdges))
      (if (or (pt-equal pt (car e))
              (pt-equal pt (cadr e)))
        (progn
          (setq found e)
          (setq tail (cdr bEdges))
        )
        (setq head (cons e head)
              bEdges (cdr bEdges))
      )
    )
    (if found
      (list found (append (reverse head) tail))
      (list nil   (append (reverse head) tail))
    )
  )

  ;;-----------------------------------------
  ;; 3Dポリラインを作成
  ;; pts: 頂点リスト
  ;; lay: レイヤ名
  ;; closed: Tなら閉じたポリライン(ビット1オン)
  ;;-----------------------------------------
  (defun make-3dpoly (pts lay closed / flag pl)
    (setq flag (if closed 9 8))  ; 8:3Dポリライン / +1で閉じる
    ;; POLYLINE 本体
    (setq pl
      (entmakex
        (list
          '(0 . "POLYLINE")
          (cons 8 lay)
          '(66 . 1)                   ; 頂点あり
          (cons 70 flag)              ; フラグ
          '(10 0.0 0.0 0.0)
        )
      )
    )
    ;; VERTEX 群
    (foreach p pts
      (entmakex
        (list
          '(0 . "VERTEX")
          (cons 8 lay)
          (cons 10 p)
          '(70 . 32)                  ; 3Dポリライン用頂点
        )
      )
    )
    ;; SEQEND
    (entmakex
      (list
        '(0 . "SEQEND")
        (cons 8 lay)
      )
    )
    pl
  )

  ;;-----------------------------------------
  ;; メイン処理
  ;;-----------------------------------------
  (prompt "\nTIN を構成する 3DFACE を選択してください。")

  (if (setq ss (ssget '((0 . "3DFACE"))))
    (progn
      (setq i 0
            edges nil)

      ;; 3DFACE から全エッジを列挙してカウント
      (while (< i (sslength ss))
        (setq ent (ssname ss i)
              ed  (entget ent)
              lay (cdr (assoc 8 ed))
              v1  (fix-pt (cdr (assoc 10 ed)))
              v2  (fix-pt (cdr (assoc 11 ed)))
              v3  (fix-pt (cdr (assoc 12 ed)))
              v4  (fix-pt (cdr (assoc 13 ed)))
        )

        ;; 三角でも四角でもOKなようにエッジを追加
        (setq edges (add-edge v1 v2 lay edges))
        (setq edges (add-edge v2 v3 lay edges))

        (if (not (pt-equal v3 v4))
          (progn
            ;; 四角面:v3-v4, v4-v1
            (setq edges (add-edge v3 v4 lay edges))
            (setq edges (add-edge v4 v1 lay edges))
          )
          (progn
            ;; 三角面:v3-v1
            (setq edges (add-edge v3 v1 lay edges))
          )
        )

        (setq i (1+ i))
      )

      ;; 出現回数1回のエッジだけを抽出 → 境界エッジ
      (setq bEdges nil)
      (foreach e edges
        (if (= (cadddr e) 1)
          ;; (p1 p2 lay)
          (setq bEdges (cons (list (car e) (cadr e) (caddr e)) bEdges))
        )
      )

      (if (null bEdges)
        (prompt "\n境界エッジが見つかりませんでした。")
        (progn
          (prompt "\n境界エッジから 3Dポリラインを生成しています...")

          (setq chains nil)

          ;; 境界エッジをつないで輪郭ポリライン群を作成
          (while bEdges
            ;; 1本取り出してチェーン開始
            (setq e0    (car bEdges)
                  bEdges (cdr bEdges))

            (setq lay   (caddr e0)
                  pts   (list (car e0) (cadr e0)))

            ;; 末尾側に接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (lastpt pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (lastpt pts) (car e))
                    (setq pts (append pts (list (cadr e))))
                    (setq pts (append pts (list (car e))))
                  )
                )
                (setq loop nil)
              )
            )

            ;; 先頭側にも接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (car pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (car pts) (car e))
                    (setq pts (cons (cadr e) pts))
                    (setq pts (cons (car e)  pts))
                  )
                )
                (setq loop nil)
              )
            )

            ;; このチェーンを登録(lay と pts)
            (setq chains (cons (list lay pts) chains))
          )

          ;; すべてのチェーンから 3Dポリラインを作成
          (foreach ch chains
            (setq lay (car ch)
                  pts (cadr ch))
            (make-3dpoly
              pts
              lay
              (pt-equal (car pts) (lastpt pts)) ; closed?
            )
          )

          (prompt "\n境界 3Dポリラインを生成しました。")
        )
      )
    )
    (prompt "\n3DFACE が選択されませんでした。")
  )

  (princ)
)

使い方

  1. 上のコードを TINBND.lsp などの名前で保存。
  2. AutoCAD で APPLOADTINBND.lsp を読み込む。
  3. コマンドラインに TINBND と入力 → Enter。
  4. 「TIN を構成する 3DFACE を選択してください。」と表示されるので、TIN のすべての三角面を窓選択などで選んで Enter。
  5. TIN の境界線が 3Dポリライン(閉じていれば閉じた3Dポリ、開いていれば開いた3Dポリ)として、元の3DFACEのレイヤ上に生成されます。

まずはこの版を試してみて、

  • 期待通りの輪郭になっているか
  • レイヤや閉じ方、出力の仕方を変えたいか

など教えてもらえれば、さらに調整版も作れます。

エラーの修正

ChatGPTが出してくれたコードを早速試してみたところ、
おおっと、エラーが出ました……

ChatGPTにフィードバックして、デバグしてもらいましょう。


エラー画面のスクリーンショットとともに、投げたプロンプトがこちら

コマンドを実行したところ、エラーが出ます。
原因を検証して、対応してください。

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

エラー原因はここです👇

(defun pt-equal (p1 p2 / tol)
  (setq tol 1e-8)
  (and (equal (car   p1) (car   p2) tol)
       (equal (cadr  p1) (cadr  p2) tol)
       (equal (caddr p1) (caddr p2) tol))
)

pt-equal が呼ばれたときに、
p1 や p2 が「点のリスト」ではなく数値(例:83.8176)だった 場面があり、
その状態で (car p1) を実行したため、

引数のタイプが間違っています: consp 83.8176

というエラーになっています。

なので、

  1. p1 / p2 がリストかどうかを確認してから car する
  2. リストでない場合も安全に比較できるようにする

ように pt-equal を書き換えます。
ついでにコード全体もそのまま貼り直します。


修正版コード(pt-equal を安全化)

;;;---------------------------------------------
;;; TIN の境界線を 3Dポリラインとして生成
;;; コマンド名:TINBND
;;;---------------------------------------------

(defun c:TINBND ( / ss i ent ed lay v1 v2 v3 v4 edges bEdges)

  ;;-----------------------------------------
  ;; 2D点なら z=0 を付けて3Dにする安全策
  ;;-----------------------------------------
  (defun fix-pt (pt)
    (cond
      ((and (listp pt) (= (length pt) 2))
       (list (car pt) (cadr pt) 0.0)
      )
      ((and (listp pt) (= (length pt) 3))
       pt
      )
      (T (list 0.0 0.0 0.0))
    )
  )

  ;;-----------------------------------------
  ;; 境界判定用の点比較(許容差付き)
  ;; p1 / p2 がリストでない場合も安全に扱う
  ;;-----------------------------------------
  (defun pt-equal (p1 p2 / tol)
    (setq tol 1e-8)
    (cond
      ;; 両方とも 3要素の点リスト
      ((and (listp p1) (listp p2)
            (= (length p1) 3)
            (= (length p2) 3))
       (and (<= (abs (- (car   p1) (car   p2))) tol)
            (<= (abs (- (cadr  p1) (cadr  p2))) tol)
            (<= (abs (- (caddr p1) (caddr p2))) tol))
      )
      ;; それ以外(数値同士など)は equal の許容差付きで比較
      (T (equal p1 p2 tol))
    )
  )

  ;;-----------------------------------------
  ;; エッジリストにエッジを追加(共有回数カウント)
  ;; edges の要素は (p1 p2 lay cnt)
  ;; p1-p2 と p2-p1 は同じエッジとしてカウント
  ;;-----------------------------------------
  (defun add-edge (p1 p2 lay edges / e newEdges found)
    (setq p1 (fix-pt p1)
          p2 (fix-pt p2)
          newEdges nil
          found nil)
    (while edges
      (setq e (car edges))
      (if (and (null found)
               (or (and (pt-equal p1 (car e))  (pt-equal p2 (cadr e)))
                   (and (pt-equal p1 (cadr e)) (pt-equal p2 (car e)))))
        (progn
          ;; 共有回数を +1
          (setq e (list (car e) (cadr e) (caddr e) (1+ (cadddr e))))
          (setq found T)
        )
      )
      (setq newEdges (cons e newEdges))
      (setq edges (cdr edges))
    )
    ;; 見つからなければ新規エッジとして追加
    (if (not found)
      (setq newEdges (cons (list p1 p2 lay 1) newEdges))
    )
    (reverse newEdges)
  )

  ;;-----------------------------------------
  ;; リストの最後の要素(点)を取り出す
  ;;-----------------------------------------
  (defun lastpt (lst)
    (car (last lst))
  )

  ;;-----------------------------------------
  ;; 指定の点 pt と接続するエッジを
  ;; bEdges から1本だけ取り出しつつ削除
  ;; bEdges の要素は (p1 p2 lay)
  ;; 戻り値:(list 見つかったエッジ 新しいbEdges)
  ;;-----------------------------------------
  (defun take-connected-edge (pt bEdges / e head found tail)
    (setq head nil
          found nil
          tail  nil)
    (while (and bEdges (null found))
      (setq e (car bEdges))
      (if (or (pt-equal pt (car e))
              (pt-equal pt (cadr e)))
        (progn
          (setq found e)
          (setq tail (cdr bEdges))
        )
        (setq head (cons e head)
              bEdges (cdr bEdges))
      )
    )
    (if found
      (list found (append (reverse head) tail))
      (list nil   (append (reverse head) tail))
    )
  )

  ;;-----------------------------------------
  ;; 3Dポリラインを作成
  ;; pts: 頂点リスト
  ;; lay: レイヤ名
  ;; closed: Tなら閉じたポリライン(ビット1オン)
  ;;-----------------------------------------
  (defun make-3dpoly (pts lay closed / flag pl)
    (setq flag (if closed 9 8))  ; 8:3Dポリライン / +1で閉じる
    ;; POLYLINE 本体
    (setq pl
      (entmakex
        (list
          '(0 . "POLYLINE")
          (cons 8 lay)
          '(66 . 1)                   ; 頂点あり
          (cons 70 flag)              ; フラグ
          '(10 0.0 0.0 0.0)
        )
      )
    )
    ;; VERTEX 群
    (foreach p pts
      (entmakex
        (list
          '(0 . "VERTEX")
          (cons 8 lay)
          (cons 10 p)
          '(70 . 32)                  ; 3Dポリライン用頂点
        )
      )
    )
    ;; SEQEND
    (entmakex
      (list
        '(0 . "SEQEND")
        (cons 8 lay)
      )
    )
    pl
  )

  ;;-----------------------------------------
  ;; メイン処理
  ;;-----------------------------------------
  (prompt "\nTIN を構成する 3DFACE を選択してください。")

  (if (setq ss (ssget '((0 . "3DFACE"))))
    (progn
      (setq i 0
            edges nil)

      ;; 3DFACE から全エッジを列挙してカウント
      (while (< i (sslength ss))
        (setq ent (ssname ss i)
              ed  (entget ent)
              lay (cdr (assoc 8 ed))
              v1  (fix-pt (cdr (assoc 10 ed)))
              v2  (fix-pt (cdr (assoc 11 ed)))
              v3  (fix-pt (cdr (assoc 12 ed)))
              v4  (fix-pt (cdr (assoc 13 ed)))
        )

        ;; 三角でも四角でもOKなようにエッジを追加
        (setq edges (add-edge v1 v2 lay edges))
        (setq edges (add-edge v2 v3 lay edges))

        (if (not (pt-equal v3 v4))
          (progn
            ;; 四角面:v3-v4, v4-v1
            (setq edges (add-edge v3 v4 lay edges))
            (setq edges (add-edge v4 v1 lay edges))
          )
          (progn
            ;; 三角面:v3-v1
            (setq edges (add-edge v3 v1 lay edges))
          )
        )

        (setq i (1+ i))
      )

      ;; 出現回数1回のエッジだけを抽出 → 境界エッジ
      (setq bEdges nil)
      (foreach e edges
        (if (= (cadddr e) 1)
          ;; (p1 p2 lay)
          (setq bEdges (cons (list (car e) (cadr e) (caddr e)) bEdges))
        )
      )

      (if (null bEdges)
        (prompt "\n境界エッジが見つかりませんでした。")
        (progn
          (prompt "\n境界エッジから 3Dポリラインを生成しています...")

          (setq chains nil)

          ;; 境界エッジをつないで輪郭ポリライン群を作成
          (while bEdges
            ;; 1本取り出してチェーン開始
            (setq e0    (car bEdges)
                  bEdges (cdr bEdges))

            (setq lay   (caddr e0)
                  pts   (list (car e0) (cadr e0)))

            ;; 末尾側に接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (lastpt pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (lastpt pts) (car e))
                    (setq pts (append pts (list (cadr e))))
                    (setq pts (append pts (list (car e))))
                  )
                )
                (setq loop nil)
              )
            )

            ;; 先頭側にも接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (car pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (car pts) (car e))
                    (setq pts (cons (cadr e) pts))
                    (setq pts (cons (car e)  pts))
                  )
                )
                (setq loop nil)
              )
            )

            ;; このチェーンを登録(lay と pts)
            (setq chains (cons (list lay pts) chains))
          )

          ;; すべてのチェーンから 3Dポリラインを作成
          (foreach ch chains
            (setq lay (car ch)
                  pts (cadr ch))
            (make-3dpoly
              pts
              lay
              (pt-equal (car pts) (lastpt pts)) ; closed?
            )
          )

          (prompt "\n境界 3Dポリラインを生成しました。")
        )
      )
    )
    (prompt "\n3DFACE が選択されませんでした。")
  )

  (princ)
)

この修正版では、

  • pt-equal数値を渡されても落ちない ようにしてあります。
  • 点リスト同士は座標ごとの差分で比較し、
    それ以外は equal の許容差付き比較にフォールバックします。

もう一度 TINBND をロードして実行してみてください。
まだ別の箇所でエラーが出るようなら、そのメッセージとスクリーンショットを見せてもらえれば、さらに詰めていきます。

スクリーンショットの内容から、エラーの状況を把握して、原因を突き止めてくれてますね。

修正版のコードを試してみたところ

3D面で構成されたTINの外縁に、3Dポリラインが生成されました。
一先ずは成功です!

コマンドの仕様を調整する

とりあえずは「3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する」オリジナルコマンドが出来ました!

しかし、もう少しコマンドの仕様を詰めてみようと思います。

調整してもらう内容は、
・3Dポリラインの色を「マゼンタ」にする
・3Dポリラインの画層を「TIN-EDGE」にする

です。
では、ChatGPT に投げてみましょう。

TINBNDを修正して下さい。
・生成する3Dポリラインの色をマゼンダ、画像を「TIN-EDGE」に設定

ChatGPTの返答がこちら

了解です。
TINBND を修正して、

  • 生成する 3Dポリラインはレイヤ名「TIN-EDGE」
  • レイヤ「TIN-EDGE」の色 = マゼンダ(AutoCAD 色番号 6)
  • ポリラインの色は BYLAYER(= レイヤ色がマゼンダ)

になるようにしました。


修正版 TINBND(レイヤ「TIN-EDGE」・色マゼンダ)

;;;---------------------------------------------
;;; TIN の境界線を 3Dポリラインとして生成
;;; コマンド名:TINBND
;;; 生成される3Dポリライン:
;;;   レイヤ = "TIN-EDGE"
;;;   色     = マゼンダ(レイヤ色)
;;;---------------------------------------------

(defun c:TINBND ( / ss i ent ed lay v1 v2 v3 v4 edges bEdges)

  ;;-----------------------------------------
  ;; レイヤ name を color で用意(なければ作成、あれば色を更新)
  ;;-----------------------------------------
  (defun ensure-layer (name color / data old62)
    (if (setq data (tblsearch "LAYER" name))
      (progn
        ;; 既存レイヤの色を変更
        (setq old62 (assoc 62 data))
        (if old62
          (setq data (subst (cons 62 color) old62 data))
          (setq data (append data (list (cons 62 color))))
        )
        (entmod data)
      )
      (entmakex
        (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          (cons 2 name)
          (cons 70 0)
          (cons 62 color)          ; レイヤ色
          (cons 6 "CONTINUOUS")
        )
      )
    )
  )

  ;;-----------------------------------------
  ;; 2D点なら z=0 を付けて3Dにする安全策
  ;;-----------------------------------------
  (defun fix-pt (pt)
    (cond
      ((and (listp pt) (= (length pt) 2))
       (list (car pt) (cadr pt) 0.0)
      )
      ((and (listp pt) (= (length pt) 3))
       pt
      )
      (T (list 0.0 0.0 0.0))
    )
  )

  ;;-----------------------------------------
  ;; 境界判定用の点比較(許容差付き)
  ;; p1 / p2 がリストでない場合も安全に扱う
  ;;-----------------------------------------
  (defun pt-equal (p1 p2 / tol)
    (setq tol 1e-8)
    (cond
      ((and (listp p1) (listp p2)
            (= (length p1) 3)
            (= (length p2) 3))
       (and (<= (abs (- (car   p1) (car   p2))) tol)
            (<= (abs (- (cadr  p1) (cadr  p2))) tol)
            (<= (abs (- (caddr p1) (caddr p2))) tol))
      )
      (T (equal p1 p2 tol))
    )
  )

  ;;-----------------------------------------
  ;; エッジリストにエッジを追加(共有回数カウント)
  ;; edges の要素は (p1 p2 lay cnt)
  ;; p1-p2 と p2-p1 は同じエッジとしてカウント
  ;;-----------------------------------------
  (defun add-edge (p1 p2 lay edges / e newEdges found)
    (setq p1 (fix-pt p1)
          p2 (fix-pt p2)
          newEdges nil
          found nil)
    (while edges
      (setq e (car edges))
      (if (and (null found)
               (or (and (pt-equal p1 (car e))  (pt-equal p2 (cadr e)))
                   (and (pt-equal p1 (cadr e)) (pt-equal p2 (car e)))))
        (progn
          ;; 共有回数を +1
          (setq e (list (car e) (cadr e) (caddr e) (1+ (cadddr e))))
          (setq found T)
        )
      )
      (setq newEdges (cons e newEdges))
      (setq edges (cdr edges))
    )
    ;; 見つからなければ新規エッジとして追加
    (if (not found)
      (setq newEdges (cons (list p1 p2 lay 1) newEdges))
    )
    (reverse newEdges)
  )

  ;;-----------------------------------------
  ;; リストの最後の要素(点)を取り出す
  ;;-----------------------------------------
  (defun lastpt (lst)
    (car (last lst))
  )

  ;;-----------------------------------------
  ;; 指定の点 pt と接続するエッジを
  ;; bEdges から1本だけ取り出しつつ削除
  ;; bEdges の要素は (p1 p2 lay)
  ;; 戻り値:(list 見つかったエッジ 新しいbEdges)
  ;;-----------------------------------------
  (defun take-connected-edge (pt bEdges / e head found tail)
    (setq head nil
          found nil
          tail  nil)
    (while (and bEdges (null found))
      (setq e (car bEdges))
      (if (or (pt-equal pt (car e))
              (pt-equal pt (cadr e)))
        (progn
          (setq found e)
          (setq tail (cdr bEdges))
        )
        (setq head (cons e head)
              bEdges (cdr bEdges))
      )
    )
    (if found
      (list found (append (reverse head) tail))
      (list nil   (append (reverse head) tail))
    )
  )

  ;;-----------------------------------------
  ;; 3Dポリラインを作成
  ;; pts: 頂点リスト
  ;; closed: Tなら閉じたポリライン(ビット1オン)
  ;; レイヤ名は常に "TIN-EDGE"
  ;; 色は BYLAYER(レイヤ「TIN-EDGE」の色=マゼンダ)
  ;;-----------------------------------------
  (defun make-3dpoly (pts closed / flag pl layName)
    (setq layName "TIN-EDGE")
    (setq flag (if closed 9 8))  ; 8:3Dポリライン / +1で閉じる
    ;; POLYLINE 本体
    (setq pl
      (entmakex
        (list
          '(0 . "POLYLINE")
          (cons 8 layName)
          '(66 . 1)                   ; 頂点あり
          (cons 70 flag)              ; フラグ
          '(10 0.0 0.0 0.0)
          (cons 62 256)               ; BYLAYER
        )
      )
    )
    ;; VERTEX 群
    (foreach p pts
      (entmakex
        (list
          '(0 . "VERTEX")
          (cons 8 layName)
          (cons 10 p)
          '(70 . 32)                  ; 3Dポリライン用頂点
        )
      )
    )
    ;; SEQEND
    (entmakex
      (list
        '(0 . "SEQEND")
        (cons 8 layName)
      )
    )
    pl
  )

  ;;-----------------------------------------
  ;; メイン処理
  ;;-----------------------------------------
  (prompt "\nTIN を構成する 3DFACE を選択してください。")

  (if (setq ss (ssget '((0 . "3DFACE"))))
    (progn
      ;; まずレイヤ "TIN-EDGE" をマゼンダで用意
      ;; AutoCAD 標準色 6 = マゼンダ
      (ensure-layer "TIN-EDGE" 6)

      (setq i 0
            edges nil)

      ;; 3DFACE から全エッジを列挙してカウント
      (while (< i (sslength ss))
        (setq ent (ssname ss i)
              ed  (entget ent)
              lay (cdr (assoc 8 ed))
              v1  (fix-pt (cdr (assoc 10 ed)))
              v2  (fix-pt (cdr (assoc 11 ed)))
              v3  (fix-pt (cdr (assoc 12 ed)))
              v4  (fix-pt (cdr (assoc 13 ed)))
        )

        ;; 三角でも四角でもOKなようにエッジを追加
        (setq edges (add-edge v1 v2 lay edges))
        (setq edges (add-edge v2 v3 lay edges))

        (if (not (pt-equal v3 v4))
          (progn
            ;; 四角面:v3-v4, v4-v1
            (setq edges (add-edge v3 v4 lay edges))
            (setq edges (add-edge v4 v1 lay edges))
          )
          (progn
            ;; 三角面:v3-v1
            (setq edges (add-edge v3 v1 lay edges))
          )
        )

        (setq i (1+ i))
      )

      ;; 出現回数1回のエッジだけを抽出 → 境界エッジ
      (setq bEdges nil)
      (foreach e edges
        (if (= (cadddr e) 1)
          ;; (p1 p2 lay)
          (setq bEdges (cons (list (car e) (cadr e) (caddr e)) bEdges))
        )
      )

      (if (null bEdges)
        (prompt "\n境界エッジが見つかりませんでした。")
        (progn
          (prompt "\n境界エッジから 3Dポリラインを生成しています...")

          (setq chains nil)

          ;; 境界エッジをつないで輪郭ポリライン群を作成
          (while bEdges
            ;; 1本取り出してチェーン開始
            (setq e0    (car bEdges)
                  bEdges (cdr bEdges))

            (setq lay   (caddr e0) ; 現在は使っていないが残しておく
                  pts   (list (car e0) (cadr e0)))

            ;; 末尾側に接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (lastpt pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (lastpt pts) (car e))
                    (setq pts (append pts (list (cadr e))))
                    (setq pts (append pts (list (car e))))
                  )
                )
                (setq loop nil)
              )
            )

            ;; 先頭側にも接続していく
            (setq loop T)
            (while loop
              (setq res (take-connected-edge (car pts) bEdges))
              (setq e   (car  res)
                    bEdges (cadr res))
              (if e
                (progn
                  (if (pt-equal (car pts) (car e))
                    (setq pts (cons (cadr e) pts))
                    (setq pts (cons (car e)  pts))
                  )
                )
                (setq loop nil)
              )
            )

            ;; このチェーンを登録
            (setq chains (cons pts chains))
          )

          ;; すべてのチェーンから 3Dポリラインを作成
          (foreach pts chains
            (make-3dpoly
              pts
              (pt-equal (car pts) (lastpt pts)) ; closed?
            )
          )

          (prompt "\n境界 3Dポリラインを生成しました。(レイヤ TIN-EDGE / 色マゼンダ)")
        )
      )
    )
    (prompt "\n3DFACE が選択されませんでした。")
  )

  (princ)
)

これで、

  • TINBND 実行 → 生成された 3Dポリラインはすべて
    レイヤ 「TIN-EDGE」、色 マゼンダ(レイヤ色)になります。

動作を確認してみて、
「色は BYENTITY で直接 6 を入れたい」「線種も変えたい」などあれば、そこも調整できます。

コマンドを実行すると

できてるようですね。
TINに穴が開いていても対応してくれています。

3Dポリラインの色は、オブジェクトのカラーではなく、ByLayer で画層の色でマゼンタになってますが、まぁ今回は、これでもいいかな。
あとは、気になるところがあれば……って、3Dポリライン閉じてないなぁ。

ChatGPTは何回仕様変更しても、文句言わずに付き合ってくれますので、気のすむまで調整して下さい。

まとめ

「3D面で構成されたTINモデルの外縁を3Dポリラインとして取得する」
というコマンドを作成してみました。
使う場面は限られますが、手作業でやると面倒なんですよね……
しかし、もっと手こずるかと思ったのですが、ChatGPTは思ったより優秀でした。
いやぁ、最近の生成AI……ホントに凄い!

ご注意


最後に、今回のコマンドはポリゴン数が少ないければ何の問題もないのですが、ポリゴン数が増えるとアルゴリズムの都合上 処理時間が指数関数的に増えていきます。

試してませんが、数千ポリゴンとかになると数時間は処理が返ってこないかもしれませんので、いきなり大量のポリゴンを処理させるのは避けた方がよいでしょう。

一旦コマンドが走ると中断することが出来ないので、お気を付けください。

ChatGPTに依頼して、処理がどこまで進んでいるか分かるようにプログレスバーを設置させたり、ESCキーなどで処理を中断できるような仕様に変更しても良いかも。

コメント

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