・ ブロック図形(図形タイプ INSERT )にネストされたオブジェクトを WCS に複製する

INSERT図形にネストされた図形オブジェクトを複製するには、アフィン変換、(vla-TransformBy) 等の方法もありますが、X Y Z の尺度が異なる INSERT 図形の場合は、不可能もしくは困難です
これを、簡単におこなうには、選択したオブジェクトのみをブロックとして作成し直して INSERT 図形を複製し、分解することで可能となります
ただし、ブロック定義をつくるので、既存のものとかぶったりしないように注意が必要です

;/////////////////////////////////////////////////////////////////////////////////////////////////;
;*** Jo_bobj_to_wcs.lsp   INSERT図形にネストされたオブジェクトを WCS に複製     By Kamijo   
;/////////////////////////////////////////////////////////////////////////////////////////////////;
(defun Jo_bobj_to_wcs ( / ent en_l en n Jof_make )
  
  ;***********************************************************************************************;
  ; サブルーチン 単一オブジェクトのブロックをつくり分解;
  (defun Jof_make (en_l / n nen ned ien ied bn ben bed n_name en)
    (setq nen (car en_l))
    (setq ned (entget nen))
    (setq n 0)
    (repeat (1- (length en_l))
      (setq ien (nth (1+ n) en_l))
      (setq ied (entget ien))
      (setq bn (cdr (assoc 2 ied)))
      (setq ben (tblobjname "BLOCK" bn))
      (setq bed (entget ben))
      (setq n_name (strcat "Jo_temp" (itoa n)))
      (setq bed (subst (cons 2 n_name)(assoc 2 bed) bed))
      (setq ied (subst (cons 2 n_name)(assoc 2 ied) ied))
      (setq ied (if (assoc 66 ied) (subst (cons 66 0) (assoc 66 ied) ied) ied));属性を持つブロックは属性無しに;
      (entmake)
      (entmake bed)
      (entmake ned)
      (entmake '((0 . "ENDBLK")))
      (if (and (setq ned (entmake ied)) (not (equal (entlast) en_l)))
        (entdel (entlast))
        (progn
          (princ (strcat "\n複合図形の作成失敗 Jof_make:" (itoa n)))
          (exit)
          )
        )
      (setq n (1+ n))
      )
    (if (entmake ned)
      (progn
        (setq en (entlast))
        (repeat (1- (length en_l))
          (command "._EXPLODE" en)
          (setq en (entlast))
          )	
        )
      )
    en
    )
  
  ;***********************************************************************************************;
  ; メインルーチン (Jo_bobj_to_wcs) ;
  (setq ent (nentsel "\n複写したいオブジェクトを選択:"))
  (if (= 4 (length ent))
    (progn
      (setq en_l (cadddr ent))
      (if (not (wcmatch (cdr (assoc 2 (entget (car en_l)))) "*`**"))
        (progn
          (if (or
                (= "VERTEX" (cdr (assoc 0 (entget (car ent)))))
                (= "ATTRIB" (cdr (assoc 0 (entget (car ent)))))
                )
            (progn
              (princ "\nそれはダメ・・・m(__)m")
              (setq en_l nil)
              )
            (setq en_l (append (list (car ent)) en_l))
            )
          )
        )
      )
    (princ "\nネストされたオブジェクトを選んでね")
    )
  (if en_l
    (progn
      (setq en (Jof_make en_l))
      (redraw en 3)
      (repeat (1- (length en_l))
        (command "._PURGE" "B" "Jo_temp*" "N");ブロック定義の削除
        )
      )
    )
  (princ)
  )