コラム

(defun c:TEST_GET_BLOCK_01 ( / blk blk_name blk_en)
;まずはブロックを選択して図形データを取得する
;※本来なら誤動作でブロック以外が選択されないような処理も入れるが、式が煩雑化するので割愛
(setq 
blk (car (entsel "Select block:"))
blk_name (cdr (assoc 2 (entget blk)))
blk_en (tblobjname "block" blk_name)
);q
(princ "\n")
(princ blk_en)
;
;whileを使ったループ処理
(while (setq blk_en (entnext blk_en))
(princ "\n")
(princ blk_en)
);while
(princ)
);defun 

(defun c:TEST_GET_BLOCK_02 ( / blk blk_name blk_en)
(setq 
blk (car (entsel "Select block:"))
blk_name (cdr (assoc 2 (entget blk)))
blk_en (tblobjname "block" blk_name)
);q
(princ "\n")
;円のDXFグループコード40番は中心座標
(princ (cdr (assoc 40 (entget blk_en))))
(while (setq blk_en (entnext blk_en))
(princ "\n")
(princ (cdr (assoc 40 (entget blk_en))))
);while
(princ)
);defun 

(defun c:TEST_MOVE_INSIDEBLOCK_EN_01 ( / blk blk_pt blk_name blk_en en_data pt_move en_move en_pt en_pt2 )
(setq 
blk (car (entsel "Select block:"))
blk_pt (cdr (assoc 10 (entget blk)))
blk_name (cdr (assoc 2 (entget blk)))
blk_en (tblobjname "block" blk_name)
pt_move (getpoint "\nClick the destination:")
en_move (list (- (car pt_move) (car blk_pt)) (- (cadr pt_move) (cadr blk_pt)) 0.0)
);q
(while (setq blk_en (entnext blk_en))
(setq en_data (entget blk_en))
(if (= 100 (cdr (assoc 40 en_data)))
(progn
(setq 
en_pt (cdr (assoc 10 en_Data))
;en_pt2 (list (+ (car en_move) (car en_pt)) (+ (cadr en_move) (cadr en_pt)) 0.0)
);q
(entmod (subst (cons 10 en_move) (assoc 10 en_data) en_data))
);pro
);if
);while
(princ)
);defun 

; 1. ベースのLISPコマンド
;
(defun c:TEST_GET_BLOCK_03 ( / blk lst)
(setq
blk (car (entsel "Select block:"))
lst '()
lst (GET_INSIDEBLOCK_EN blk lst)
);q
(princ)
);defun

; 2. ループ処理のためのLISP関数
;
(defun GET_INSIDEBLOCK_EN ( blk lst / blk_name blk_en)
(setq
blk_name (cdr (assoc 2 (entget blk)))
blk_en (tblobjname "block" blk_name)
lst (cons blk_en lst)
);q
(princ "\n")
(princ blk_en)
(while (setq blk_en (entnext blk_en))
(setq
lst (cons blk_en lst)
blk_type (cdr (assoc 0 (entget blk_en)))
);q
; 分岐処理：取得した図形がブロック（INSERT）だった場合に、GET_INSIDEBLOCK_ENを実行する。
(if (= blk_type "INSERT")
(setq lst (GET_INSIDEBLOCK_EN blk_en lst));※引数に渡す変数名は関数で定義したものと一致していなくても良いです。
);
(princ "\n")
(princ blk_en)
);while
;関数の処理結果としてリストが返るようにする
lst
);defun

;★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
;使い方
;1. ブロックを選択
;2. 挿入基点を変更したい箇所をクリック
;
;
(defun c:MBI ( / blk blk_data blk_pt blk_name blk_en pt_lst pt_lst2 en_data pt_move en_move en_pt en_pt2 VLdoc VLblks VLblk VLobj ss n en en_data en_pt en_rot);MoveBlockInsert
(while
(cond
((null blk)T)
((/= "INSERT" (cdr (assoc 0 (entget blk))))
(princ "\nNot an insert. Reselect.")
T)
((= "INSERT" (cdr (assoc 0 (entget blk))))
nil)
);cond
(while (not (setq blk (car (entsel "Select block:"))))
(princ "\nReselect.")
);while
);while
(setq 
blk_data (entget blk)
blk_pt (cdr (assoc 10 blk_data))
);q
(while (not (setq pt_move (getpoint blk_pt "\nClick New Insertion Point:")))
(princ "\nReselect.")
);while
(setq
blk_name (cdr (assoc 2 blk_data))
blk_en (tblobjname "block" blk_name)
pt_lst (GET_DISTORTED_CO blk pt_move nil)
VLdoc (vla-get-activedocument (vlax-get-acad-object))
VLblks (vla-get-blocks VLdoc)
VLblk (vla-item VLblks blk_name)
);q
(vlax-for VLobj VLblk
(vla-move VLobj (vlax-3d-point pt_lst) (vlax-3d-point '(0 0 0)))
);vlax-for
(setq ss (ssget "X" (list '(0 . "INSERT") (cons 2 blk_name))))
(if ss
(progn
(setq n (sslength ss))
(repeat n
(setq 
n (1- n)
en (ssname ss n)
en_data (entget en)
en_pt (trans (cdr (assoc 10 en_data)) en 0)
en_rot (cdr (assoc 50 en_data))
pt_lst2 (GET_DISTORTED_CO en nil pt_lst)
en_data_n (subst (cons 10 pt_lst2) (assoc 10 en_data) en_data)
);q
(entmod en_data_n)
);rep
);pro
);if
(vla-regen VLdoc acActiveViewport)
(princ (strcat "\nブロック [" blk_name "] の基点変更"))
(princ)
);defun 
;★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★GET_DISTORTED_CO
;サブ関数
;尺度や回転がかかったブロックを処理します。
;
;
;
(defun GET_DISTORTED_CO ( blk pt_move lst / blk_data blk_pt blk_name blk_en blk_rot blk_x blk_y blk_z dx_loc dy_loc dz_loc dx_wcs dy_wcs dz_wcs pt_new scale_x scale_y scale_z diff_x diff_y diff_z)
(setq 
blk_data (entget blk)
blk_pt (cdr (assoc 10 blk_data))
blk_name (cdr (assoc 2 blk_data))
blk_rot (cdr (assoc 50 blk_data))
scale_x (cdr (assoc 41 blk_data))
scale_y (cdr (assoc 42 blk_data))
scale_z (cdr (assoc 43 blk_data))
);q
(if pt_move 
(setq 
diff_x (- (car pt_move) (car blk_pt))
diff_y (- (cadr pt_move) (cadr blk_pt))
diff_z (- (caddr pt_move) (caddr blk_pt))
dx_loc (/ (+ (* diff_x (cos blk_rot)) (* diff_y (sin blk_rot))) scale_x)
dy_loc (/ (- (* diff_y (cos blk_rot)) (* diff_x (sin blk_rot))) scale_y)
dz_loc (/ diff_z scale_z)
lst (list dx_loc dy_loc dz_loc)
);q
(setq 
dx_loc (car lst)
dy_loc (cadr lst)
dz_loc (caddr lst)
dx_wcs (- (* dx_loc (cos blk_rot) scale_x) (* dy_loc (sin blk_rot) scale_y))
dy_wcs (+ (* dx_loc (sin blk_rot) scale_x) (* dy_loc (cos blk_rot) scale_y))
dz_wcs (* dz_loc scale_z)
lst (list (+ (car blk_pt) dx_wcs) (+ (cadr blk_pt) dy_wcs) (+ (caddr blk_pt) dz_wcs))
);q
);if
);defun