・ 変換マトリックス(4x4)で図形を変換する
VLISP で (vla-TransformBy) を使って変換する場合、X Y Z
の尺度が異なると、エラーになってしまいます
そこで、エンティティーデータの定義点を拾い出して、点座標をアフィン変換の上、エンティティーデータを書き直して
(entmod) または (entmake) で図形オブジェクトを作成します
図形タイプごとにコーディングが必要なので、すごい大変です
しかも、円や円弧、楕円の場合には、異尺度で変換すると、図形タイプが変わってしまうので、かなり難しいですね・・・・>私には無理です
;///////////////////////////////////////////////////////////////////////////////
;*** Jo_trans_bobj.lsp INSERT図形にネストされたオブジェクトをWCSに複製 By Kamijo
; LINE POLYLINE LWPOLYLINE SPLINE CIRCLE ARC ELLIPSE に対応
; 但し CIRCLE ARC ELLIPSE では
XYZの尺度が異なる場合正常に変換できません
;///////////////////////////////////////////////////////////////////////////////
(defun Jo_trans_bobj ( / ent en ed et mat no_l x
Jof_mat_3to4 Jof_trans Jof_del_last Jof_ch_xdist Jof_ch_ang Jof_ch_3dpt
Jof_ch_relpt Jof_ch_lwpl Jof_ch_spl Jof_ch_pl Jof_ch_vertex )
;********************************************************************************
;サブルーチン 4x3のマトリックスを4x4に変換 ;
(defun Jof_mat_3to4 ( mat / a b i mat_col x mat4)
(setq mat (mapcar '(lambda (a b) (append a (list b))) mat '(0.0 0.0 0.0 1.0)))
(setq i 0)
(repeat (length mat)
(setq mat_col (list (mapcar '(lambda (x) (nth i x)) mat)))
(setq mat4 (append mat4 mat_col))
(setq i (1+ i))
)
mat4
)
;********************************************************************************
;サブルーチン マトリックス変換 ;
(defun Jof_trans ( pt mat / x )
(setq pt (append pt '(1.0)))
(mapcar '(lambda (x) (apply '+ (mapcar '* pt x))) mat)
)
;********************************************************************************
;サブルーチン リストの最後の要素を削除 ;
(defun Jof_del_last (lst)
(reverse (cdr (reverse lst)))
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 x-distance ;
(defun Jof_ch_xdist( ed mat no_l / x pt0_l pt1_l pt2_l i )
(setq pt0_l (mapcar '(lambda (x) (cdr (assoc (cadr x) ed))) no_l))
(setq pt1_l (mapcar '(lambda (x) (list (cdr (assoc (car x) ed)) 0 0)) no_l))
(setq i 0)
(repeat (length pt0_l)
(setq pt2_l (append (list (mapcar '(lambda (x y) (+ x y)) (nth i pt0_l) (nth i pt1_l))) pt2_l))
(setq i (1+ i))
)
(setq pt0_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt0_l))
(setq pt2_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt2_l))
(setq i 0)
(repeat (length no_l)
(setq ed (subst (cons (car (nth i no_l)) (distance (nth i pt0_l)(nth i pt2_l))) (assoc (car (nth i no_l)) ed) ed))
(setq i (1+ i))
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 angle ;
(defun Jof_ch_ang( ed mat no_l / x y pt0_l pt1_l ang_l i )
(setq pt0_l (mapcar '(lambda (x) (cdr (assoc (cadr x) ed))) no_l))
(setq ang_l (mapcar '(lambda (x) (cdr (assoc (car x) ed))) no_l))
(setq pt1_l (mapcar '(lambda (x y) (polar x y 1)) pt0_l ang_l))
(setq pt0_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt0_l))
(setq pt1_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt1_l))
(setq i 0)
(repeat (length no_l)
(setq ed (subst (cons (car (nth i no_l)) (angle (nth i pt0_l) (nth i pt1_l))) (assoc (car (nth i no_l)) ed) ed))
(setq i (1+ i))
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 3D_point ;
(defun Jof_ch_3dpt( ed mat no_l / x pt_l i )
(setq pt_l (mapcar '(lambda (x) (cdr (assoc x ed))) no_l))
(setq pt_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt_l))
(setq i 0)
(repeat (length no_l)
(setq ed (subst (cons (nth i no_l) (nth i pt_l)) (assoc (nth i no_l) ed) ed))
(setq i (1+ i))
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 relative point ;
(defun Jof_ch_relpt( ed mat no_l / x pt_l pt_r )
(setq pt_l (mapcar '(lambda (x) (cdr (assoc x ed))) no_l))
(setq pt_l (list (mapcar '(lambda (x y) (+ x y)) (car pt_l) (cadr pt_l)) (cadr pt_l)))
(setq pt_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt_l))
(setq pt_r (mapcar '(lambda (x y) (- x y)) (car pt_l) (cadr pt_l)))
(setq ed (subst (cons (car no_l) pt_r) (assoc (car no_l) ed) ed))
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 LWPOLYLINE ;
(defun Jof_ch_lwpl( ed mat / edx d_38 d_210 d_10 pt pt_l ptt_l x i )
(setq edx ed)
(setq d_38 (list (if (assoc 38 ed) (cdr (assoc 38 ed)) 0.0)))
(setq d_210 (cdr (assoc 210 ed)))
(while (setq d_10 (cdr (setq pt (assoc 10 edx))))
(setq pt_l (append pt_l (list d_10)))
(setq ptt_l (append ptt_l (list (trans (append d_10 d_38) d_210 0))))
(setq edx (cdr (member pt edx)))
)
(setq ptt_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) ptt_l))
(setq ptt_l (mapcar 'Jof_del_last ptt_l))
(setq i 0)
(repeat (length pt_l)
(setq ed (subst (cons 10 (nth i ptt_l)) (cons 10 (nth i pt_l)) ed))
(setq i (1+ i))
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 SPLINE ;
(defun Jof_ch_spl( ed mat d_no / edx d_data pt pt_l ptt_l x i )
(setq edx ed)
(while (setq pt (cdr (setq d_data (assoc d_no edx))))
(setq pt_l (append pt_l (list pt)))
(setq edx (cdr (member d_data edx)))
)
(setq ptt_l (mapcar '(lambda (x) (Jof_del_last (Jof_trans x mat))) pt_l))
(setq i 0)
(repeat (length pt_l)
(setq ed (subst (cons d_no (nth i ptt_l)) (cons d_no (nth i pt_l)) ed))
(setq i (1+ i))
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの取得 POLYLINE ;
(defun Jof_ch_pl ( en / ed )
(while en
(if (= "SEQEND" (cdr (assoc 0 (setq ed (entget (setq en (entnext en)))))))
(progn
(setq ed (entget (cdr (assoc -2 ed))))
(setq en nil)
)
)
)
ed
)
;********************************************************************************
; サブルーチン エンティティーデータの変更 VERTEX ;
(defun Jof_ch_vertex( ed mat / en d_10z )
(setq en (cdr (assoc -1 ed)))
(setq d_10z (list (last (cdr (assoc 10 ed)))))
(while en
(setq ed (entget (setq en (entnext en))))
(if (= 2 (length (assoc 10 ed)))
(setq ed (subst (cons 10 (append (cdr (assoc 10 ed)) d_10_z)) (assoc 10 ed) ed))
)
(setq ed (Jof_ch_3dpt ed mat '(10)))
(if (entmake ed);POLYLINEを作画;
(if (= "SEQEND" (cdr (assoc 0 ed)))
(setq en nil)
)
(progn
(entmake)
(princ "\nentmakeの失敗:VERTEX")
(exit)
)
)
)
(setq en (entlast));作画したPOLYLINEの図形名を返す;
)
;********************************************************************************
; メインルーチン (Jo_trans_bobj) ;
(while (not en)
(setq ent (nentsel "\nネストされたオブジェクトを選択:"))
(if (= 4 (length ent))
(progn
(setq en (car ent))
(setq mat (Jof_mat_3to4 (caddr ent)));4x4のマトリックスに変換 ;
(setq et (cdr (assoc 0 (setq ed (entget en)))))
(cond
((= et "LINE")(setq ed (Jof_ch_3dpt ed mat '(10 11))))
((= et "CIRCLE")(progn
(foreach x '((40 10)) (setq no_l (if (assoc (car x) ed) (append no_l (list x)))))
(setq ed (Jof_ch_xdist ed mat no_l))
(setq ed (Jof_ch_3dpt ed mat '(10)))
))
((= et "ARC")(progn
(foreach x '((40 10)) (setq no_l (if (assoc (car x) ed) (append no_l (list x)))))
(setq ed (Jof_ch_xdist ed mat no_l))
(setq no_l nil)
(foreach x '((50 10) (51 10)) (setq no_l (if (assoc (car x) ed) (append no_l (list x)))))
(setq ed (Jof_ch_ang ed mat no_l))
(setq ed (Jof_ch_3dpt ed mat '(10)))
))
((= et "LWPOLYLINE") (setq ed (Jof_ch_lwpl ed mat )))
((= et "VERTEX") (setq ed (Jof_ch_pl en )))
((= et "SPLINE") (foreach x '(10 11) (setq ed (Jof_ch_spl ed mat x ))))
((= et "ELLIPSE") (progn
(if (and (/= (cdr (assoc 41 ed)) 0.0) (/= (cdr (assoc 42 ed) (* pi 2))))
(progn
(foreach x '((41 10) (42 10)) (setq no_l (if (assoc (car x) ed) (append no_l (list x)))))
(setq ed (Jof_ch_ang ed mat no_l))
)
)
(setq ed (Jof_ch_relpt ed mat '(11 10)))
(setq ed (Jof_ch_3dpt ed mat '(10)))
))
(T (progn
(princ "\nこのオブジェクトはダメ・・m(__)m")
(setq ed nil)
))
)
(if (entmake ed)
(progn
(if (= "POLYLINE" (cdr (assoc 0 ed)))
(setq en (Jof_ch_vertex ed mat))
(setq en (entlast))
)
)
(setq en nil)
)
)
(princ "\nネストされたオブジェクトを選択してね")
)
)
(redraw en 3)
(princ)
)
参考文献: http://www1.harenet.ne.jp/~hanafusa/memo/matrix.htm