;;;-------------------<第７回 宿題>---------------------------------
;;;
;;;   ピッチ指定削除コマンド
;;;
;;;  2001.10.16                                  Programed by mapcar
;;;-----------------------------------------------------------------
;; 考え方のポイント
;; 削除対象図形が周期的に現れるわけですから、対象図形の特徴点
;; (始点や終点）が周期的位置にあるかどうかが判定できれば図形を特定
;; できると考えました。a_on_period_pt で判定処理を行っています。
;; 
;; また、図形によって特徴点が異なるので、図形ごとに cond 文で処理を分ける
;; ようにして、 LINE だけでなく その他の図形(CIRCLE, ARC ...) への拡張にも
;; 対応するようにしました。
;; 
;; 削除図形の特定をゆるい(簡単な)条件でうまく絞り込むことが大切ですね。
;;------------------------------------------------------------------
(defun c:mapcar_7
  (
  /
    ent en0 en1 lim ety0 ety1 name lay p0 p1 filter ss ii enl0 enl1 
  )
    (if (setq en0 (car (setq ent (entsel "\n最初の図形を指示:")))) (progn
        (setq p1 (getpoint (cadr ent) "\n有効範囲を指示:"))
        (if (and p1 (setq en1 (car (entsel "\n次の図形(間隔)を指示:")))) (progn
            (setq lim (distance (cadr ent) p1)) ; 有効範囲
            (setq ety0 (entget en0))
            (setq ety1 (entget en1))
            (setq name (cdr (assoc 0 ety0)))
            (setq lay  (cdr (assoc 8 ety0)))
            (setq p0 (cdr (assoc 10 ety0)))
            (if (and (= name (cdr (assoc 0 ety1))) ; 同じ図形種であること
                     (= lay  (cdr (assoc 8 ety1))) ; レイヤーが同じであること
                     (/= p0 (cdr (assoc 10 ety1))) ; 基準位置が異なること
                ) (progn
                
                (setq filter (list (cons 0 name) (cons 8 lay)))
                (if (setq ss (ssget "X" filter)) (progn ; 候補図形を取得
                    (repeat (setq ii (sslength ss)) ; 選択セットを図形名リストに変換
                        (setq enl0 (cons (ssname ss (setq ii (1- ii))) enl0))
                    )
                    (cond ; 図形タイプ別に候補を絞り込む
                        ((= name "LINE")    (setq enl1 (a_select_opline    ety0 ety1 enl0 lim)))
                       ;((= name "CIRCLE")  (setq enl1 (a_select_opcircle  ety0 ety1 enl0 lim)))
                       ;((= name "ARC")     (setq enl1 (a_select_oparc     ety0 ety1 enl0 lim)))
                    )
                    (mapcar 'entdel enl1) ; 抽出図形を削除
                ))
            ))
        ))
    ))
    (princ)
)

(defun a_select_opline ; 周期上にある LINE 図形を選択する
  (
    ety0 ; 基準となる LINE
    ety1 ; 周期基準 LINE
    enl0 ; 検査対象 LINE群(ety0, ety1 と同一のレイヤ)
    lim  ; 有効範囲
  /
    p0 p1 p2 wl uv0 ff enl1
  )
    (setq p0 (cdr (assoc 10 ety0))) ; 基準 LINE 始点
    (setq p1 (cdr (assoc 11 ety0))) ; 基準 LINE 終点
    (setq p2 (cdr (assoc 10 ety1))) ; 周期基準 LINE 始点
    (setq wl (distance p0 p2)) ;展開波長
    (setq uv0 (mapcar '/ (mapcar '- p2 p0) (list wl wl wl))) ; 展開方向
    (setq ff 0.001) ; 比較許容誤差
    (mapcar '(lambda ( en / ety p2 p3 )
        (setq ety (entget en))
        (setq p2 (cdr (assoc 10 ety)))
        (setq p3 (cdr (assoc 11 ety)))
        (if (and (< (distance p0 p2) lim)
                 (a_on_period_pt p0 p2 uv0 wl ff)
                 (a_on_period_pt p1 p3 uv0 wl ff))
            (setq enl1 (cons en enl1))
        )
    ) enl0)
    enl1
)

(defun a_on_period_pt ; 周期上に乗っている点か否か？
  (
    p0  ; 原点
    p1  ; 検査点
    uv0 ; 周期方向
    wl  ; 波長
    ff  ; 比較許容誤差
  /
    len uv1 de nn pe
  )
    (setq len (distance p0 p1)) ; p0-p1 間の距離
    (if (/= len 0.0)
        (progn
            (setq uv1 (mapcar '/ (mapcar '- p1 p0) (list len len len))) ; p0-p1 方向ベクトル
            (setq de (distance uv0 uv1)) ; 方向誤差
        (setq nn (fix (/ len (* wl (- 1.0 ff))))) ; 周期数
        (setq pe (- len (* nn wl))) ; 周期誤差
        (and (< de ff) (< pe ff))
    ))
)