AutoCADマクロ屋本舗 掲示板

お世話になります。オートキャド2025を使用いています。
直線状に配列された円があります。配列個数は様々です。この配列の円を範囲選択し、個数が偶数個なら偶数番目の円を探して削除、奇数なら奇数番目の円を削除。偶数=2.4.6 …
…、奇数=1.3.7……　　ということのできるリスプまたはマクロを作成していただきたいのです。よろしくお願いします。

Y座標の小さい方から、1番目2番目・・・としています。水平に並んでいる(Y座標が同じ)の場合はX座標の小さい方から1番目2番目・・・

(VL-LOAD-COM)
(defun c:SortCircles ( / ss circles sorted-circles)
;; 円だけを選択
(setq ss (ssget '((0 . "CIRCLE"))))

;; 選択セットから円のリストを作成
(setq circles (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (vl-remove-if 'null (mapcar 'cadr (ssnamex ss))))))

;; 円の中心座標を取得し、Y座標順にソート
(setq sorted-circles (vl-sort circles '(lambda (a b) (< (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b))))))))

;; Y座標が同じ場合、X座標順にソート
(setq sorted-circles (vl-sort sorted-circles '(lambda (a b) (if (= (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b))))) (< (car (assoc 10 (entget (vlax-vla-object->ename a)))) (car (assoc 10 (entget (vlax-vla-object->ename b))))) (< (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b)))))))))

(while (not (member (setq input (getint "\n奇数の場合は[0]、偶数の場合は[1]を入力してください: ")) '(0 1)))
(prompt "\n無効な入力です。0か1を入力してください。")
)
(vl-cmdf "undo" "be")
(setq i input)
(while (>= (length sorted-circles) i)
;; 指定されたインデックスのオブジェクトを削除
(vla-delete (nth i sorted-circles))
(setq i (+ i 2))
)
(vl-cmdf "undo" "e")
(PRINC)
)

Hamu様
ありがとうございます。
早速実行してみます。大変お世話になりました。

>個数が偶数個なら偶数番目の円を探して削除、奇数なら奇数番目の円を削除
これが出来るようにしました。
奇数個の場合は、どちらが1番目でも同じ結果ですが、偶数個の場合は、消す・残すが希望とは逆の場合が有りますので、
偶数を消した後は、消す・残すを反転するか聞かれます。

(vl-load-com)
(defun c:SortCircles ( / ss circles sorted-circles)
;; 円だけを選択
(setq ss (ssget '((0 . "CIRCLE"))))

;; 選択セットから円のリストを作成
(setq circles (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (vl-remove-if 'null (mapcar 'cadr (ssnamex ss))))))

;; 円の中心座標を取得し、Y座標順にソート
(setq sorted-circles (vl-sort circles '(lambda (a b) (< (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b))))))))

;; Y座標が同じ場合、X座標順にソート
(setq sorted-circles (vl-sort sorted-circles '(lambda (a b) (if (= (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b))))) (< (car (assoc 10 (entget (vlax-vla-object->ename a)))) (car (assoc 10 (entget (vlax-vla-object->ename b))))) (< (cdr (assoc 10 (entget (vlax-vla-object->ename a)))) (cdr (assoc 10 (entget (vlax-vla-object->ename b)))))))))

(setq input (rem (1+ (length sorted-circles)) 2))

(setq boolean T)
(while boolean
(vl-cmdf "undo" "be")
(setq i input)
(while (>= (length sorted-circles) i)
;; 指定されたインデックスのオブジェクトを削除
(vla-delete (nth i sorted-circles))
(setq i (+ i 2))
)
(vl-cmdf "undo" "e")
(if (= input 0)
(progn
(setq boolean nil)
(princ "\n奇数番目を削除しました")
)
(if (getpoint "\n偶数番目を削除しました。反転する場合は左クリック。確定は右クリック：")
(progn
(setq sorted-circles (reverse sorted-circles))
(vl-cmdf "u")
)
(setq boolean nil)
)
)
)
(princ)
)

Hamu様　

ありがとうございます。
二度もご教授いただき恐れ入ります。早速実行してみます。ありがとうござしました。