;;;-------------------<宿題６>------------------------------------ ;;; ;;; オフセットコマンド ;;; ;;; 2001.07.15 Programed by mapcar ;;; 2001.07.24 提出 ;;;----------------------------------------------------------------- ;;; 機能： ８の字型に描かれた閉ポリラインでも、NTTマークポリラインでも ;;; ちゃんとオフセットします。 ;;; 通常のオフセットコマンドとの違いをご確認ください。 ;;; 対応している図形は ふくらみを持たない POLYLINE, LWPOLYLINE ;;; です。 ;;;----------------------------------------------------------------- (setq g_ang 60.0) ; とんがり部カット開始角度 <-- 未対応 (defun c:mapcar_6_y ; ホントのオフセットコマンド ( / ent ph p1 ety en typ ang fpp cf pp off seg pn pa pb ) (if (setq ent (entsel "ポリラインを指示:")) (progn (setq ety (entget (setq en (car ent)))) (setq typ (cdr (assoc 0 ety))) (if (or (= typ "POLYLINE") (= typ "LWPOLYLINE")) (progn (setq dcpp (c_get_pline_pp en 0)) ; 頂点(WCS)情報を取得 (setq cf (cadr dcpp)) ; 閉フラグを取得 (setq pp (caddr dcpp)) ; 頂点列を抽出 (setq ph (cadr ent)) ; 指示点を取得 (setq seg (nearest_seg pp ph)) ; 近接点情報取得 (setq ucs (seg_ucs (car seg) (cadr seg))) ; 指示した辺の座標系 (setq pn (caddr seg)) ; 近接点 (setq pt (getpoint pn "オフセットする側を指示:")) ; オフセット指示点 (setq off (car (c_wcs2ucs1 pt ucs))) ; オフセット量 (setq ang (* (/ g_ang 180.0) pi)) ; (setq pp (omit_zero_seg pp)) ; 長さ０の辺を除去 (setq pp (calc_offset cf pp off ang)) ; オフセットされた頂点を算出 (if (= typ "POLYLINE") (emk_poly pp en) (emk_lwpoly pp en) ) )) )) (princ) ) (defun nearest_seg ; 触った辺の座標と近接点を返す ( pp ; 頂点列 ph ; 指示した座標 / cf segl ucs phux hit off ) ; ph と 各辺の位置関係情報を計算する (setq segl (mapcar '(lambda ( p0 p1 / uy ux uz ucs pn xx) (setq ucs (seg_ucs p0 p1)) (setq pn (c_wcs2ucs1 ph ucs)) ; ucs から見た ph の座標値 (setq xx (car pn)) (setq pn (c_ucs2wcs1 (list 0.0 (cadr pn) (caddr pn)) ucs)) ; 近接点座標 (list (abs xx) (list p0 p1 pn)) ) pp (cdr pp))) (setq hit (apply 'min (mapcar 'car segl))) ; 一番近い辺までの距離を得る (cadr (assoc hit segl)) ; ヒットした辺の座標系でオフセット指示点を見る ) (defun seg_ucs ; 線分の座標系を得る 2001.07.16 ( p0 ; 線分始点 p1 ; 線分終点 / ux uy uz ) (setq uy (c_uv (c_vector p0 p1))) ; 辺p0-p1座標系Ｙ軸 (setq ux (c_rotateR90 uy)) ; 辺p0-p1座標系Ｘ軸 (setq uz (c_ij2k ux uy)) ; 辺p0-p1座標系Ｚ軸 (list p0 (list ux uy uz) '(1.0 1.0 1.0)) ; 線分p0--p1座標系 ) (defun calc_offset ; 頂点列のオフセット点列を求める 2001.07.16 ( cf pp1 off ang / pa pb p0 p1 pp0 pp2 pp ) (if cf ; オフセット用補助頂点を求める (progn (setq pa (last pp1)) (setq pb (car pp1)) ) (progn (setq p0 (car pp1)) (setq p1 (cadr pp1)) (setq pa (mapcar '+ p0 (c_vector p1 p0))) (setq p0 (car (reverse pp1))) (setq p1 (cadr (reverse pp1))) (setq pb (mapcar '+ p0 (c_vector p1 p0))) ) ) (setq pp0 (append (list pa) pp1)) ; 前点列 (setq pp2 (append (cdr pp1) (list pb))) ; 後点列 (setq pp (mapcar '(lambda ( p0 p1 p2 / ucs01 q0 q1 ucs12 q2 q3 res) (setq ucs01 (seg_ucs p0 p1)) (setq q0 (c_ucs2wcs1 (list off 0.0 0.0) ucs01)) (setq q1 (c_ucs2wcs1 (list off (distance p0 p1) 0.0) ucs01)) (setq ucs12 (seg_ucs p1 p2)) (setq q2 (c_ucs2wcs1 (list off 0.0 0.0) ucs12)) (setq q3 (c_ucs2wcs1 (list off (distance p1 p2) 0.0) ucs12)) (setq res (inters q0 q1 q2 q3 nil)) ; 一直線上をあとで考慮のこと (if (not res) (setq res q1)) ; (getpoint res) res ) pp0 pp1 pp2)) pp ) (defun emk_poly ; POLYLINE を生成する 2001. 07.16 ( pp en0 ; ひな形主エンティティ ) (setq ety0 (entget en0)) (setq ety1 (entget (setq en1 (entnext en0)))) ; 頂点ひな形 (setq ety (mapcar '(lambda ( code ) (assoc code ety0) ) '(0 8 70 40 41 71 72 73 74 75))) (setq en (entmake ety)) (mapcar '(lambda ( pj ) (setq pj (trans pj 0 en0)) (setq ety1 (subst (cons 10 pj) (assoc 10 ety1) ety1)) (entmake ety1) ) pp) (entmake '((0 . "SEQEND"))) en ) (defun emk_lwpoly ; LWPOLYLINE を生成する 2001.07.24 ( pp en0 ; ひな形主エンティティ / ety0 ety1 ) (setq ety0 (entget en0)) (setq ety1 (mapcar '(lambda ( elm / res ) (if (= (car elm) 10) (progn (setq res (cons 10 (car pp))) (setq pp (cdr pp)) res ) elm ) ) ety0)) (entmake ety1) ) (defun c_get_pline_pp ; 3DPOLYLINE の頂点座標を取得する ; 2000.12.14 ( ; 2000.04.22 Ta_guchi en ; POLYLINE/LINE/LWPOLYLINE sw ; 座標変換スイッチ 0: WCS 1:UCS nil:ECS / ety typ ej pj pp cf d3 p0 p1 pm vz zz ) (setq ety (entget en)) (setq vz (cdr (assoc 210 ety))) (setq typ (cdr (assoc 0 ety))) (cond ((= typ "POLYLINE") (setq d3 (= (logand (cdr (assoc 70 ety)) 8) 8)) ; 3D / 2D (setq cf (= (logand (cdr (assoc 70 ety)) 1) 1)) ; クローズフラグ (setq ety (entget (setq ej (entnext en)))) (while (= (cdr (assoc 0 ety)) "VERTEX") (setq pj (cdr (assoc 10 ety))) ; (setq pj (if sw (trans pj en sw) pj)) (setq pj (if sw (trans pj vz sw) pj)) (setq pp (append pp (list pj))) (setq ety (entget (setq ej (entnext ej)))) ) (list d3 cf pp) ) ((= typ "LINE") (setq d3 nil cf nil) (setq p0 (cdr (assoc 10 ety))) ; (setq p0 (if sw (trans p0 en sw) p0)) (setq p0 (if sw (trans p0 vz sw) p0)) (setq p1 (cdr (assoc 11 ety))) ; (setq p1 (if sw (trans p1 en sw) p1)) (setq p1 (if sw (trans p1 vz sw) p1)) (list d3 cf (list p0 p1)) ) ((= typ "LWPOLYLINE") (setq d3 (= (logand (cdr (assoc 70 ety)) 8) 8)) ; 3D / 2D (setq cf (= (logand (cdr (assoc 70 ety)) 1) 1)) ; クローズフラグ (setq zz (cdr (assoc 38 ety))) (mapcar '(lambda ( etj / pj ) (if (equal (car etj) 10) (progn ; 40 41 幅 42 ふくらみ (setq pj (append (cdr etj) (list zz))) ; (setq pj (if sw (trans pj en sw) pj)) (setq pj (if sw (trans pj vz sw) pj)) (setq pp (append pp (list pj))) )) ) ety) (list d3 cf pp) ) ) ) ;----< ベクトル処理関数抜粋 >---- (defun c_vector ( p0 p1 ) (mapcar '- p1 p0)) ; ベクトル表現 2001.04.25 (defun c_vlength ( vv ) (distance '(0 0 0) vv)) ; ベクトル長さを求める 2000.12.04 (defun c_inner ( v0 v1 ) (apply '+ (mapcar '* v0 v1))) ; ベクトル内積 2000.04.15 (defun c_vscale ( sc vv ) (mapcar '* (list sc sc sc) vv)) ; ベクトルのスカラー倍 (defun c_uv ( vv ) ; 単位ベクトルを求める 2000.04.15 (c_vscale (/ 1.0 (c_vlength vv)) vv) ) (defun c_outer ; ベクトル外積 2000.04.15 ( v0 v1 / x0 y0 z0 x1 y1 z1) (mapcar 'set '(x0 y0 z0) v0) (mapcar 'set '(x1 y1 z1) v1) (list (- (* y0 z1) (* z0 y1)) (- (* z0 x1) (* x0 z1)) (- (* x0 y1) (* y0 x1)) ) ) (defun c_ij2k ( vi vj ) (c_uv (c_outer vi vj))) ;ｉ軸、ｊ軸からｋ軸を求める 2001.04.25 (defun c_rotateR90 ( v0 ) ; Ｚ軸回り90度右回転* (list (cadr v0) (- (car v0)) (caddr v0)) ) (defun c_wcs2ucs ; WCS 座標値を 指定の UCS 座標値に変換する* ( pp ; 座標値リスト ucs ; UCS座標定義 / org ijk scale ; 原点、方向、尺度 ) (mapcar 'set '(org ijk scale) ucs) (mapcar '(lambda ( pt ) (setq pt (mapcar '- pt org)) ; UCS 原点相対形式に (setq pt (mapcar '(lambda ( uv ) (c_inner pt uv)) ijk)) ; UCS 方向成分に (mapcar '/ pt scale) ; UCS 尺度に ) pp) ) (defun c_wcs2ucs1 ( pt ucs ) ; WCS 座標値を UCS で表現する 2001.05.09 (car (c_wcs2ucs (list pt) ucs)) ) ;;; 2000.11.26 ucs にスケール処理を追加 (defun c_ucs2wcs ; UCS 座標値を WCS 座標値に変換する* ( pp ucs / org ijk scale ; 原点、方向、尺度 ) (mapcar 'set '(org ijk scale) ucs) (mapcar '(lambda ( pt / vv ) (setq vv '(0.0 0.0 0.0)) ; (setq vv g_000) (setq pt (mapcar '* pt scale)) ; WCS 尺度に変換 (mapcar '(lambda ( vj ) (setq vv (mapcar '+ vv vj)) ; WCS 成分ごとに積算 ) (mapcar 'c_vscale pt ijk)) ; WCS 成分に分解 (mapcar '+ org vv) ; 絶対座標に調整 ) pp) ) (defun c_ucs2wcs1 ( pt ucs ); UCS 系座標値を WCS で表現する 2001.05.09 (car (c_ucs2wcs (list pt) ucs)) ) (princ "\nコマンド名は mapcar_6_y です。") (princ)