【AutoCAD LISP】ブロックや矢印を線に平行に配置する|POの使い方

桝や矢印、部材などのブロックを 、斜めの通路や基準線に合わせて配置するとき、意外と手間がかかります。

基準となる線の角度を確認して、ブロックを回転して、さらに位置を調整する。1個ならそれほどでもありませんが、数が増えると同じ操作の繰り返しになります。

AutoLISP「PO」は、配置したいブロックや矢印の向きを、基準となる線と平行に合わせるLISPです。ブロックや矢印と基準線を選んだら、マウスで位置を決めて配置できます。

文字を線に合わせる「SA」と同じような使い方です。

PO
ブロックや矢印を、基準線に平行にして配置
PO_ParallelObjects.lsp

※音声はありません。

💡このLISPでできること

  • 桝や基礎などのブロックを、斜めの基準線や通路に平行に配置する
  • 矢印などのポリラインも、基準線に合わせて配置する

POは、文字を線に沿わせるSA、複数文字をまとめて沿わせるMTAに続く、「平行シリーズ」の第3弾です。

フクロウ
フクロウ

SAを使ったことがあれば、操作感はかなり似ています。
「配置するオブジェクトを選ぶ → 基準線を選ぶ → マウスで位置を決める」という流れなので、角度を数字で調べたり、回転参照の必要はありません。

🛠️POの使い方

  1. コマンドラインへ PO と入力し、EnterまたはSpaceで確定します。
  2. 平行に配置したいブロック、線またはポリライン(矢印等)を選択します。
  3. 平行の基準となる線またはポリラインを選択します。
  4. マウスを動かして配置する位置と向きを確認します。
  5. 向きを変えたい場合は、配置中にSpaceキーを押します。
  6. 配置したい位置で左クリックして確定します。

Spaceキーを押すたびに90°ずつ回転します。矢印の向きを反対にしたい場合は、Spaceキーを2回押して180°回転させます。

💾 ダウンロードとコード

LISPファイルをダウンロード

収録ファイル:PO_ParallelObjects.lsp
※ダウンロード後、「すべて展開(解凍)」してから使用してください。

LISPを初めて使う方は、読み込み方法をこちらの記事で確認できます。
AutoCADでLISPをロードする3つの方法

このLISPはECW_Utilityがなくても基本機能を使用できます。ECW_Utilityを導入している環境では、共通のUNDO・エラー処理と連携します。
ECW_Utilityの役割と導入方法

コードのコピーは+をクリック↓

Lisp
;;; Support: https://easycadwork.com
;;; X(follow me!): https://x.com/easycadwork
;;; 概要: 選択した図形を基準線に沿わせてリアルタイムに移動・回転し、1クリックで確定する

(vl-load-com)

;; 曲線パラメータ取得失敗時は距離経由で再取得する。
;; 数値を取得できない場合は nil を返し、呼び出し側で処理する。
(defun PO90_CurveAngle (ent pt / par dist deriv result)
  (setq result (vl-catch-all-apply 'vlax-curve-getParamAtPoint (list ent pt)))
  (if (not (vl-catch-all-error-p result)) (setq par result))
  (if (not (numberp par))
    (progn
      (setq result (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list ent pt)))
      (if (and (not (vl-catch-all-error-p result)) (numberp result))
        (progn
          (setq dist result
                result (vl-catch-all-apply 'vlax-curve-getParamAtDist (list ent dist)))
          (if (not (vl-catch-all-error-p result)) (setq par result))
        )
      )
    )
  )
  (if (numberp par)
    (progn
      (setq result (vl-catch-all-apply 'vlax-curve-getFirstDeriv (list ent par)))
      (if (not (vl-catch-all-error-p result)) (setq deriv result))
      (if (and (listp deriv) (numberp (car deriv)) (numberp (cadr deriv))
               (> (+ (* (car deriv) (car deriv)) (* (cadr deriv) (cadr deriv))) 0.0))
        (angle '(0 0 0) deriv)
      )
    )
  )
)

(defun c:po (/ sel1 ent1 pt_sel1 entData1 objType1 pt_baseWCS ang_origWCS
               sel2 ent2 vlaObj previewObj enPreview pt_prevWCS ang_prevWCS rotOffset loop
               code ptCurUCS ptSnap ptCurWCS ptNearWCS ang_refWCS ang_finalWCS)

  ;; 共通ユーティリティの有無を確認して実行(ハイブリッド設計)
  (if (type ECW_Error) (setq *error* ECW_Error))
  (if (type ECW_Start) (ECW_Start))

  ;; --- 1. 移動元の図形を選択し、情報を自動取得 ---
  (if (setq sel1 (entsel "\n平行に配置したい矢印(ポリライン)またはブロックを選択: "))
    (progn
      (setq ent1     (car sel1)
            pt_sel1  (cadr sel1)
            entData1 (entget ent1)
            objType1 (cdr (assoc 0 entData1))
            vlaObj   (vlax-ename->vla-object ent1))

      (cond
        ;; ブロックの場合
        ((= objType1 "INSERT")
         (setq pt_baseWCS (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint vlaObj)))
               ang_origWCS (vla-get-Rotation vlaObj))
        )
        ;; 線・ポリラインの場合
        ((wcmatch objType1 "LINE,*POLYLINE")
         (setq pt_baseWCS (vlax-curve-getClosestPointTo ent1 (trans pt_sel1 1 0))
               ang_origWCS (PO90_CurveAngle ent1 pt_baseWCS))
         (if (not (numberp ang_origWCS))
           (progn
             (princ "\n※移動元の方向を取得できません。別の位置を選択してください。")
             (setq ent1 nil)
           )
         )
        )
        (T
         (princ "\n※線、ポリライン、またはブロックを選択してください。")
         (setq ent1 nil)
        )
      )

      ;; --- 2. 基準線の選択 ---
      (if ent1
        (if (setq sel2 (entsel "\n平行の基準となる線(LINE/POLYLINE)を選択: "))
          (progn
            (setq ent2 (car sel2))
            (if (wcmatch (cdr (assoc 0 (entget ent2))) "LINE,*POLYLINE")
              (progn
                ;; --- 3. プレビュー図形の準備 ---
                (setq previewObj  (vla-Copy vlaObj)
                      enPreview   (vlax-vla-object->ename previewObj)
                      pt_prevWCS  pt_baseWCS
                      ang_prevWCS ang_origWCS
                      ang_finalWCS ang_origWCS
                      rotOffset   0.0
                      loop        T)

                ;; 元図形は移動確定まで非表示にする(0 = 非表示)
                (vla-put-Visible vlaObj 0)

                (princ "\n配置位置をクリック (Spaceキー: 90度回転 / Esc・右クリック: キャンセル): ")

                ;; --- 4. リアルタイム追従ループ (grread) ---
                (while loop
                  (setq code (grread T 13 0))
                  (cond
                    ;; [マウス移動] ぬるぬる追従処理
                    ((= (car code) 5)
                     (setq ptCurUCS (cadr code))

                     ;; 自己スナップ防止
                     (entdel enPreview)
                     (setq ptSnap (osnap ptCurUCS "_nea,_end,_mid,_int"))
                     (entdel enPreview)

                     (if ptSnap (setq ptCurUCS ptSnap))
                     (setq ptCurWCS (trans ptCurUCS 1 0))

                     ;; 基準線の角度を取得して回転
                     (setq ptNearWCS (vlax-curve-getClosestPointTo ent2 ptCurWCS))
                     (if (and ptNearWCS
                              (numberp (setq ang_refWCS (PO90_CurveAngle ent2 ptNearWCS))))
                       (progn
                         (setq ang_finalWCS ang_refWCS)

                         (setq ang_finalWCS (+ ang_finalWCS rotOffset))

                         (vla-Move   previewObj (vlax-3d-point pt_prevWCS) (vlax-3d-point ptCurWCS))
                         (vla-Rotate previewObj (vlax-3d-point ptCurWCS) (- ang_finalWCS ang_prevWCS))

                         (setq pt_prevWCS  ptCurWCS
                               ang_prevWCS ang_finalWCS)
                       )
                     )
                    )

                    ;; [左クリック] 移動を確定して終了
                    ((= (car code) 3)
                     (setq ptCurUCS (cadr code))

                     ;; 自己スナップ防止
                     (entdel enPreview)
                     (setq ptSnap (osnap ptCurUCS "_nea,_end,_mid,_int"))
                     (entdel enPreview)

                     (if ptSnap (setq ptCurUCS ptSnap))
                     (setq ptCurWCS (trans ptCurUCS 1 0))

                     ;; プレビューを確定位置へ移動・回転
                     (vla-Move   previewObj (vlax-3d-point pt_prevWCS) (vlax-3d-point ptCurWCS))
                     (vla-Rotate previewObj (vlax-3d-point ptCurWCS) (- ang_finalWCS ang_prevWCS))

                     ;; 元図形を削除し、プレビューが「移動後の図形」として残る
                     (vla-Delete vlaObj)

                     (setq loop nil)
                     (princ "\n移動が完了しました。")
                    )

                    ;; [右クリック または Esc] キャンセル
                    ((or (= (car code) 11) (= (car code) 25))
                     ;; プレビューを消去し、元図形を再表示して復元(-1 = 表示)
                     (vla-Delete previewObj)
                     (vla-put-Visible vlaObj -1)
                     (setq loop nil)
                     (princ "\nキャンセルしました。元の図形を復元しました。")
                    )

                    ;; [キーボード入力] Spaceキーで90度回転
                    ((= (car code) 2)
                     (if (= (cadr code) 32)
                       (progn
                         (setq rotOffset   (rem (+ rotOffset (/ pi 2.0)) (* 2.0 pi))
                               ang_finalWCS (+ ang_prevWCS (/ pi 2.0)))
                         (vla-Rotate previewObj (vlax-3d-point pt_prevWCS) (/ pi 2.0))
                         (setq ang_prevWCS ang_finalWCS)
                       )
                     )
                    )
                  ) ; end cond
                ) ; end while
              )
              (princ "\n※基準は線またはポリラインを選択してください。")
            )
          )
          (princ "\n※基準線が選択されませんでした。")
        )
      )
    )
    (princ "\n※図形が選択されませんでした。")
  )

  (if (type ECW_End) (ECW_End))
  (princ)
)

✏️まとめ:角度を調べず、線を選んで合わせる

斜めの通路に桝やサイン基礎を合わせる場合、角度を調べてから回転する方法もあります。

[参照]を使う場合でも、

回転 → 基点をクリック →[参照]→ オブジェクト側を2点クリック → 合わせたい方向を2点クリック……。

できるけど、毎回やるとなると、やっぱりめんどくさい。

POなら、オブジェクトを選んで、合わせたい線を選ぶ。あとはマウスで位置を決めるだけ。

もともとは、桝やサイン基礎などのブロックを斜めの通路に合わせやすくするために作ったLISPでした。

ところが実際に使ってみると、私がよく使っているのは、側溝の流水方向を示す矢印を平行に揃える作業です。

排水方向の矢印は、側溝の向きに合わせて何本も配置することがあります。そんなとき、基準となる線を選ぶだけで向きを合わせられるPOはかなり便利です。

フクロウ
フクロウ

SA、MTA、POと対象は違いますが、考え方は同じです。

コメント