Множественная вставка блока, висящего на курсоре
(defun ru-block-multi-insert-scaled-rotated-or-angleask (block_name
x_scale
y_scale
block_angle
/
curr_layer
do_insert
ins_point
is_attrib
sub_ent
tmp_angle
tmp_block
tmp_ent
unnamed_block
put_point
exp_block
)
;;;
;|------------------------------------------------------------------
Множественная вставка блока, висящего на курсоре
Аргументы:
block_name - имя блока, определенного в рисунке
x_scale - масштаб по Х
y_scale - масштаб по У
block_angle - угол поворота -В РАДИАНАХ!
;;;
;|------------------------------------------------------------------
Проверяем, не установлен ли перспективный вид - в нем не будет работать
команда CHANGE
-------------------------------------------------------------------|;
(if (ru-ucs-z-is-parallel-wcs)
(progn
(setq do_insert t
;;;
;|------------------------------------------------------------------
Временная точка вставки за пределами видимой части экрана
-------------------------------------------------------------------|;
ins_point
(list (+ (car (getvar "VSMAX"))
(* 2 (max x_scale y_scale))
) ;_ end of +
(+ (cadr (getvar "VSMAX"))
(* 2 (max x_scale y_scale))
) ;_ end of +
0.0
) ;_ end of list
;;;
;|------------------------------------------------------------------
Временный угол поворота блока. Нужен, если в аргументах поворот
задан NIL (признак необходимости запроса угла поворота)
-------------------------------------------------------------------|;
tmp_angle
(if block_angle
block_angle
0
) ;_ end of if
curr_layer
(getvar "CLAYER")
) ;_ end of setq
;;;
;|------------------------------------------------------------------
Вставляем временный блок за пределы видимой части экрана
-------------------------------------------------------------------|;
(if (setq tmp_block (ru-block-insert-obj
block_name
ins_point
x_scale
y_scale
1.0
tmp_angle
) ;_ end of ru-block-insert-obj
) ;_ end of setq
(progn
;;;
;|------------------------------------------------------------------
Создаем из временного блока временный примитив. Зачем? Чтобы
приклеить к нему атрибуты?
-------------------------------------------------------------------|;
(setq tmp_block (vlax-vla-object->ename tmp_block)
tmp_ent tmp_block
) ;_ end of setq
(entmake (list (cons 0 "BLOCK")
(cons 100 "AcDbEntity")
(cons 100 "AcDbBlockBegin")
(cons 2 "*U0")
(cons 8 curr_layer)
(cons 70 1)
(cons 62 256)
(cons 10 ins_point)
;; (cons 10 (trans ins_point 1 0))
) ;_ end of list
) ;_ end of entmake
(entmake (entget tmp_ent))
;;;
;|------------------------------------------------------------------
Создаем для временного блока атрибуты, имеющиеся в основном блоке
-------------------------------------------------------------------|;
(while (setq tmp_ent (entnext tmp_ent))
(if (= (cdr (assoc 0 (setq sub_ent (entget tmp_ent))))
"ATTRIB"
) ;_ end of =
(setq is_attrib t)
) ;_ end of if
(entmake sub_ent)
) ;_ end of while
;;;
;|------------------------------------------------------------------
Может возникнуть вполне закономерный вопрос - а зачем, собственно,
создаётся временный анонимный блок из вставки пользовательского блока?
На первый взгляд, процедура эта совершенно лишена смысла, но,
как это часто бывает, причина снова кроется в ошибках AutoCAD -
начиная с версии 2000, команда 'CHANGE' имеет ошибку, которая выражается
в некорректном перемещении вставки блока с разными по знаку масштабными коэффициентами по разным осям.
Для решения этой проблемы и был предусмотрен механизм создания временного анонимного блока
из вставки пользовательского блока.
При этом пользовательский блок вставляется с теми масштабными коэффициентами,
которые заданы при вызове функции, но к этой вставке не применяется команда 'CHANGE',
а анонимный блок, которым подменяется пользовательский блок,
всегда используется со всеми коэффициентами равными единице,
соответственно, у команды 'CHANGE' не возникает повода проявить свой норов.
-------------------------------------------------------------------|;
(setq unnamed_block
(entmake (list (cons 0 "ENDBLK")
(cons 100 "AcDbEntity")
(cons 100 "AcDbBlockEnd")
(cons 8 curr_layer)
) ;_ end of list
) ;_ end of entmake
) ;_ end of setq
;;;
;|------------------------------------------------------------------
Удаляем временный блок
-------------------------------------------------------------------|;
(entdel tmp_block)
) ;_ end of progn
(setq do_insert nil)
) ;_ end of if
;;;
;|------------------------------------------------------------------
Начинаем цикл вставки. Вставляем анонимный блок во временную точку вставки
-------------------------------------------------------------------|;
(while do_insert
(setq tmp_block (vlax-vla-object->ename
(ru-block-insert-obj
unnamed_block
ins_point
1.0
1.0
1.0
0.0
) ;_ end of ru-block-insert-obj
) ;_ end of vlax-vla-object->ename
) ;_ end of setq
;;;
;|------------------------------------------------------------------
Имитируем вставку. Запрашиваем точку вставки, но на самом деле используем
команду CHANGE. В этот момент изображение блока висит на курсоре
-------------------------------------------------------------------|;
(princ "
Точка вставки <Хватит!>: ")
(if (or (not (setq do_insert (vl-cmdf "_.CHANGE"
tmp_block
""
""
pause
""
) ;_ end of vl-cmdf
) ;_ end of setq
) ;_ end of not
;;;
;|------------------------------------------------------------------
Проверка на совпадение измененной "точки вставки" с прежним положением
блока. При нажатии Enter команда CHANGE оставит блок в прежней точке.
Условие совпадения точек является проверкой нажатия Enter. При нажатии
ESC функция vl-cmdf вернет NIL. Продолжение процессов "вставки"
будет только при указании точки, но не при нажатии клавиш Enter или Esc
-------------------------------------------------------------------|;
(equal
(setq put_point (cdr (assoc 10 (entget tmp_block))))
ins_point
1e-6
) ;_ end of equal
) ;_ end of or
(setq do_insert nil)
(progn
;;;
;|------------------------------------------------------------------
Если угол поворота был в аргументах задан как NIL, аналогичным образом выполняется
визуальный поворот блока
-------------------------------------------------------------------|;
(if (not block_angle)
(progn
(princ "
Угол поворота <0>: ")
(setq do_insert (vl-cmdf "_.CHANGE"
tmp_block
""
""
""
pause
) ;_ end of vl-cmdf
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
(if do_insert
(progn
;;;
;|------------------------------------------------------------------
Адаптация к 2004-ому. Учтена особенность (явный глюк) 2004-ого когда
при расчленении безымянного блока он сбрасывает результат в точку
вставки безымянного блока + точку использованную при его определении.
-------------------------------------------------------------------|;
;;;* Mark error-2004 #1
(setq exp_block
(car
(vlax-safearray->list
(vlax-variant-value
(vla-explode
(vlax-ename->vla-object
tmp_block
) ;_ end of vlax-ename->vla-object
) ;_ end of vla-explode
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of car
) ;_ end of setq
;;;* End of mark error-2004 #1
;;;
;|------------------------------------------------------------------
Выполняется редактирование атрибутов, если они есть
-------------------------------------------------------------------|;
(if is_attrib
(vl-cmdf "_.DDATTE" (entlast))
) ;_ end of if
;;;* Mark error-2004 #2
(vla-put-insertionpoint
exp_block
(vlax-3d-point put_point)
) ;_* Mark #2
;;;* End of mark error-2004 #2
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
;;;
;|------------------------------------------------------------------
Удаляем временный блок.
-------------------------------------------------------------------|;
(entdel tmp_block)
) ;_ end of while
) ;_ end of progn
(alert (strcat "
Ось Z текущей ПСК не параллельна оси Z МСК."
"
Выполение команды прекращено."
) ;_ end of strcat
) ;_ end of alert
) ;_ end of if
(princ)
) ;_ end of defun
