Тема: LISP. Изменение базовой точки блока
;|============================================= Изменение базовой точки блока Программа Дениса Флюстикова "bBlock_Den" Макрос для кнопки: ^C^C^P(load "bBlock_Den");bBlock_Den Замечания и предложения по адресу fd-@mail.ru ===============================================|; (defun C:bBlock_Den (/ aa0 aa1 aa2 aa3 aa4 aa5 aa6) (setq aa4 nil) (while (null aa4) (if (setq aa1 (entsel "\nВыберите блок:"))(progn (setq aa1 (car aa1) aa2 (entget aa1)) (if (= (cdr (assoc 0 aa2)) "INS ERT") (if (wcmatch (setq aa3 (cdr (assoc 2 aa2))) "`**") (princ "\nПрограмма не работает с неименованными блоками") (setq aa6 (list (cdr (assoc 41 aa2)) (cdr (assoc 42 aa2)) (cdr (assoc 43 aa2))) aa4 (cdr (assoc 50 aa2)) aa2 (cdr (assoc 10 aa2))) ) (princ "\nБлок не выбран") ) )) ) (if aa3 (progn (setq aa0 (getpoint "\nНовая базовая точка:") aa4 (- (angle aa0 aa2) aa4) aa2 (polar '(0 0 0) aa4 (distance aa2 aa0)) aa2 (mapcar '/ aa2 aa6)) (setvar "CMDECHO" 0) (command "_.undo" "_g" "_.-bedit" aa3 "_.move" (ssget "_A") "" '(0 0 0) aa2 "_.bclose" "_s") (setq aa1 (ssget "_A" (list (cons 0 "INS ERT")(cons 2 aa3)))) (repeat (setq aa3 (sslength aa1)) (setq aa3 (1- aa3) aa4 (ssname aa1 aa3) aa6 (entget aa4) aa0 (list (cdr (assoc 41 aa6)) (cdr (assoc 42 aa6)) (cdr (assoc 43 aa6))) aa5 (cdr (assoc 50 aa6)) aa6 (cdr (assoc 8 aa6)) aa0 (mapcar '* aa0 aa2) aa5 (+ (angle aa0 '(0 0 0)) aa5) aa5 (polar '(0 0 0) aa5 (distance aa0 '(0 0 0)))) (if (= (cdr (assoc 70 (tblsearch "Layer" aa6))) 4) (command "_.'layer" "_u" aa6 "") (se tq aa6 nil) ) (command "_.move" aa4 "" '(0 0 0) aa5) (if aa6 (command "_.'layer" "_lo" aa6 "") ) ) (command "_.undo" "_e") (se tvar "CMDECHO" 1) )) (princ) )