短冊形ボーリング柱状図の各ファイルを羅列するLISPを作成した

(defun c:bordxf (/ *doc* *ms* acad sel_path f_ext files margin x_coord ins_pt full_path res minp maxp ll ur w high_y dy)
  (vl-load-com)
  
  (setq acad (vlax-get-acad-object))
  (setq *doc* (vla-get-activedocument acad))
  (setq *ms* (vla-get-modelspace *doc*))

  ;; 1. 形式の選択
  (initget 1 "DWG DXF Both")
  (setq f_ext (getkword "\n対象を選択 [DWG(W)/DXF(X)/両方(B)]: "))
  (if (not f_ext) (setq f_ext "Both"))

  ;; 2. フォルダ選択
  (setq sel_path (get_folder_dialog "図面フォルダを選択してください"))
  
  (if (and sel_path (/= sel_path ""))
    (progn
      ;; 固定間隔ではなく「図面間の隙間（余白）」を入力してもらう
      (setq margin (getdist "\n図面間の余白を入力: "))
      (setq x_coord 0.0)
      
      (cond
        ((= f_ext "DWG") (setq files (vl-directory-files sel_path "*.dwg" 1)))
        ((= f_ext "DXF") (setq files (vl-directory-files sel_path "*.dxf" 1)))
        (t (setq files (append (vl-directory-files sel_path "*.dwg" 1)
                               (vl-directory-files sel_path "*.dxf" 1))))
      )

      (if files
        (progn
          (vla-StartUndoMark *doc*)
          (setvar "INSUNITS" 0)

          (foreach f files
            (setq full_path (strcat sel_path "\\" f))
            ;; 一旦現在の x_coord に挿入
            (setq ins_pt (vlax-3d-point (list x_coord 0.0 0.0)))

            (princ (strcat "\n配置中: " f "..."))
            
            (setq res (vl-catch-all-apply 'vla-InsertBlock 
                        (list *ms* ins_pt full_path 1.0 1.0 1.0 0.0)))

            (if (not (vl-catch-all-error-p res))
                (progn
                  ;; --- 幅と高さの計算 ---
                  (vla-GetBoundingBox res 'minp 'maxp)
                  (setq ll (vlax-safearray->list minp)) ; 左下
                  (setq ur (vlax-safearray->list maxp)) ; 右上
                  
                  (setq w (- (car ur) (car ll)))      ; 図面の横幅
                  (setq high_y (cadr ur))             ; Yの最大値
                  
                  ;; 1. 上端を Y=0 に合わせる
                  (setq dy (* -1.0 high_y))
                  ;; 2. 左端を現在の x_coord に合わせる（(0,0)原点でない図面対策）
                  (setq dx (- x_coord (car ll)))
                  
                  (vla-Move res (vlax-3d-point '(0 0 0)) (vlax-3d-point (list dx dy 0)))
                  
                  ;; 分解
                  (vla-Explode res)
                  (vla-delete res)
                  
                  ;; 次の配置座標 = 現在のX + この図面の幅 + 余白
                  (setq x_coord (+ x_coord w margin))
                  (princ " [OK]")
                )
                (princ " [エラー]")
            )
          )
          (vla-EndUndoMark *doc*)
          (vla-ZoomExtents acad)
        )
        (princ "\nファイルが見つかりません。")
      )
    )
  )
  (princ)
)

;; フォルダ選択用
(defun get_folder_dialog (msg / shell folder folder_obj path)
  (setq shell (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
  (setq folder (vlax-invoke-method shell 'BrowseForFolder 0 msg 0 ""))
  (if folder
    (progn
      (setq folder_obj (vlax-get-property folder 'Self))
      (vlax-get-property folder_obj 'Path)
    )
    nil
  )
)

;; エイリアス
(defun c:BD () (c:bordxf))<br>