Программа+макрос на кнопку "Удаление повторяющихся элементов" для AutoCAD 2006 (Страница 3 из 4)

;************** er_ar.lsp *********************************************************
;          Программа, обратная массиву. Стирает объекты с
;          заданным шагом по осям X и Y. Шаги должны быть
;          точно определены и заданы такими же, какие
;          использовались в массиве. Сначала удаляются
;          объекты по осям X и Y, потом диагональные объекты.
;          Не рекомендуется пропускать удаление ортогональных
;          объектов, иначе можно запутаться. Здесь вообще
;          можно запутаться, поэтому лучше сначала проверить
;          работу программы в пустом рисунке с разными массивами.
;
;          Разработал [b]Profan[/b].
;
(defun C:ER_AR ( / sx sy flag p1x p1y px py p1xy pxy)
        (setvar "CMDECHO" 0)
        (setq sx (getint "\n Шаг по оси X: "))
        (setq sy (getint "\n Шаг по оси Y: "))
        (setq flag T)
(while flag
        (setq p1x (getpoint "\n Укажите точку на объекте-шаблоне (Enter-закончить): "))
        (if p1x
        (progn
        (setq p1y p1x p1xy p1x)
        (repeat 1000
                (setq px (list (+ (car p1x) sx) (cadr p1x)))
                (command "_ERASE" px "")
                (setq p1x px)
       ); repeat
       (repeat 1000
               (setq py (list (car p1y) (+ (cadr p1y) sy)))
               (command "_ERASE" py "")
               (setq p1y py)
       ); repeat
       ); progn
       (setq flag nil)
       ); if
); while
       (setq p1xy (getpoint "\n Укажите точку на диагональном объекте-шаблоне (Enter-отказ): "))
       (if p1xy
       (progn
       (repeat 1000
               (setq pxy (list (+ (car p1xy) sx) (+ (cadr p1xy) sy)))
               (command "_ERASE" pxy "")
               (setq p1xy pxy)
       ); repeat
       ); progn
       ); if
(princ)
)

^C^C^P(if (not C:ER_AR) (load "er_ar") ER_AR

;************** er_ar.lsp *********************************************************
;          erase_array
;          Программа, обратная массиву. Стирает объекты с
;          заданным расстояниями между рядами и столбцами,
;          такими же, которые использовались в массиве.
;          Число рядов и столбцов также должно быть таким же,
;          какое было в массиве. В противном случае возможна
;          неконтролируемая потеря объектов.
;          Разработал Владимир Громов.
;
(defun C:ER_AR ( / ss pob ob ny nx sy sx poy)
        (setvar "CMDECHO" 0)
        (setq ss (entsel "\n Выберите объект: "))
        (setq pob (cadr ss))
        (setq ob (car ss))
        (setq ny (getint "\n Число рядов (---): "))
        (setq nx (getint "\n Число столбцов (|||): "))
        (setq sy (getint "\n Расстояние между рядами (---): "))
        (setq sx (getint "\n Расстояние между столбцами (|||): "))
        (setq poy pob)
    (if pob
        (progn
        (command "_COPY" ob "" pob pob)
        (repeat ny
                (repeat nx
                (command "_ERASE" pob "")
                (setq pob (list (+ (car pob) sx) (cadr pob)))
                ); repeat
        (setq pob (list (car poy) (+ (cadr pob) sy)))
        ); repeat
        ); progn
    ); if
        (princ)
)

^C^C^P(if (not C:ER_AR) (load "er_ar") ER_AR

;************** er_ar.lsp *********************************************************
;          erase_array
;          Программа, обратная массиву. Стирает объекты с
;          заданным расстояниями между рядами и столбцами,
;          такими же, которые использовались в массиве.
;          Число рядов и столбцов также должно быть таким же,
;          какое было в массиве. В противном случае возможна
;          неконтролируемая потеря объектов.
;          Разработал Владимир Громов.
;
(defun C:ER_AR ( / ss pob ob ny nx sy sx poy)
        (setvar "CMDECHO" 0)
        (setq ss (entsel "\n Выберите объект: "))
        (setq pob (cadr ss))
        (setq ob (car ss))
        (setq ny (getint "\n Число рядов (---): "))
        (setq nx (getint "\n Число столбцов (|||): "))
        (setq sy (getreal "\n Расстояние между рядами (---): "))
        (setq sx (getreal "\n Расстояние между столбцами (|||): "))
        (setq poy pob)
    (if pob
        (progn
        (command "_COPY" ob "" pob pob)
        (repeat ny
                (repeat nx
                (command "_ERASE" pob "")
                (setq pob (list (+ (car pob) sx) (cadr pob)))
                ); repeat
        (setq pob (list (car poy) (+ (cadr pob) sy)))
        ); repeat
        ); progn
    ); if
        (princ)
)

^C^C^P(if (not C:ER_AR) (load "er_ar") ER_AR