[Джин]

Доброго времени суток, уважаемые!
Суть просьбы заключается вот в чем:
Выделив несколько одинаковых примитивов на чертеже, задаем одному примитиву точку масштабирования (допустим от центра), а остальные примитивы, могли масштабироваться каждый от своего центра, а не смещались относительно того примитива, на котором была указана точка.
С фигурами, наверное так не получится, но хотя-бы с примитивами...

[Kseon]

Мда, затея неплохая, но скорее всего не реализуемая. Потому как, всё должно быть привязано к одной координате.

[Perezz!!]

Было бы здорово. В Максе есть панелька для этого даже заточенная.

[X-DeViL]

В максе есть такая штука - гизмо! от нее и пляшет все... а в 2007 каде появились - DUCS... может от этого сплясать попробовать?

[Кулик Алексей aka kpblc]

Вообще-то реализуемое (если плясать от центра примитива / солида / фигуры), ЯТД. Вопрос в нужности.

[Kseon]

Вчера пригнали проект торгового центра, мадам одна делала, на печать вывел, а встроенные светильники на бумаге не "читаются".
Светильник на плане-это кружочек с двумя отрезками внутри круга. Шеф говорит переделай масштаб, это ж не долго.
Ну да, перемасштабировать 350 фигур, по старым координатам установки - сущие пустяки!
Это к вопросу о нужности.

[Кулик Алексей aka kpblc]

А эти несчастные кружки часом не блоки? Потому как я смогу сделать только одно - круг будет масштабироваться вокруг его центра, а вот отрезки - вокруг ИХ центров. Покатит? Или проще будет все же за 2 минуты сделать блок и понавставлять его в нужные точки?

[VVA]

Быстро переделал с
http://forum.dwg.ru/showthread.php?p=92287#post92287

Код:

[Выделить все]

(defun c:sm (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT 
          OBJSET VLAOBJ PTLST XLST YLST old BASEPT Flg) 
 (vl-load-com)
(if (and (setq VLAOBJ (car(entsel "\nВыберите образец для масштабирования ")))
	 (setq VLAOBJ (vlax-ename->vla-object VLAOBJ))
	 )
  (progn
  (vla-Highlight  VLAOBJ :vlax-true)
  (initget 1)
  (setq BASEPT (getpoint "\nБазовая точка масштабирования: "))
  (vla-GetBoundingBox VLAOBJ 'MinPt 'MaxPt) 
  (setq mnPt(vlax-safearray->list MinPt) 
     mxPt(vlax-safearray->list MaxPt) 
     miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt))))
  (setq BASEPT (mapcar '- BASEPT miPt))	
  (if(not sm:scale)(setq sm:scale 1))
    (initget 6)	
    (setq old sm:scale 
          sm:scale(getdist 
         (strcat"\nУкажите масштабный коэффициент <"(rtos sm:scale 2 2)">: ")) 
   ); end setq 
  (if(null sm:scale)(setq sm:scale old))
  (vla-Highlight  VLAOBJ :vlax-false)	 
  (setq errCount 0 ptLst 'nil Flg t); en setq
  (while Flg
    (princ "\n§§§ Выберите объекты и нажмите Enter или Esc для выхода. §§§") 
 (if 
   (not(setq objSet(ssget "_I"))) 
   (setq objSet(ssget)) 
   ); end if 
  (if objSet 
    (progn
      (ssadd (vlax-vla-object->ename VLAOBJ) objSet)
      (setq objSet 
       (mapcar 'vlax-ename->vla-object 
                    (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex objSet)))))
      (foreach obj objSet 
   (vla-GetBoundingBox obj 'MinPt 'MaxPt) 
    (setq mnPt(vlax-safearray->list MinPt) 
     mxPt(vlax-safearray->list MaxPt) 
     miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt)))     
     ) 
     (if 
      (vl-catch-all-error-p 
   (vl-catch-all-apply 'vla-ScaleEntity 
     (list obj(vlax-3D-Point (mapcar '+ miPt BASEPT)) sm:scale))) 
      (setq errCount(1+ errCount)) 
      )     
   ); end foreach
   (princ(strcat "\n" (itoa errCount) " объектов на блокированном слое! ")) 
   )
      ); if objset
    (setq Flg nil)
  ); end while
  ))(princ))

[Kseon]

Сообщение от kpblc А эти несчастные кружки часом не блоки? Потому как я смогу сделать только одно - круг будет масштабироваться вокруг его центра, а вот отрезки - вокруг ИХ центров. Покатит? Или проще будет все же за 2 минуты сделать блок и понавставлять его в нужные точки?

За две минуты не получится, потому как нужно сначала понавставлять новые по тем же координатам, а потом стереть старые. Прицеливаться, потом по старым довольно долго.
А предложение покатит, это намного лучше, чем вообще ничего.

[Kseon]

Попробовал поставить код от VVA, первый раз программа сработала, при попытке повторно загрузить в командной строке выходит сообщение:
**Команда не разрешена при работе на вкладке модель**

[VVA]

>Kseon Это чего-то в Акаде глюкануло. Сколько ни гонял, ни разу такого не выскочило. Там то и команд никаких не используется.
Добавил проверку на наличие метода ScaleEntity

Код:

[Выделить все]

(defun c:sm (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT 
          OBJSET VLAOBJ PTLST XLST YLST old BASEPT Flg) 
 (vl-load-com) 
(if (and (setq VLAOBJ (car(entsel "\nВыберите образец для масштабирования "))) 
    (setq VLAOBJ (vlax-ename->vla-object VLAOBJ)) 
    ) 
  (progn 
  (vla-Highlight  VLAOBJ :vlax-true) 
  (initget 1) 
  (setq BASEPT (getpoint "\nБазовая точка масштабирования: ")) 
  (vla-GetBoundingBox VLAOBJ 'MinPt 'MaxPt) 
  (setq mnPt(vlax-safearray->list MinPt) 
     mxPt(vlax-safearray->list MaxPt) 
     miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt)))) 
  (setq BASEPT (mapcar '- BASEPT miPt))    
  (if(not sm:scale)(setq sm:scale 1)) 
    (initget 6)    
    (setq old sm:scale 
          sm:scale(getdist 
         (strcat"\nУкажите масштабный коэффициент <"(rtos sm:scale 2 2)">: ")) 
   ); end setq 
  (if(null sm:scale)(setq sm:scale old)) 
  (vla-Highlight  VLAOBJ :vlax-false)    
  (setq errCount 0 ptLst 'nil Flg t); en setq 
  (while Flg 
    (princ "\n§§§ Выберите объекты и нажмите Enter или Esc для выхода. §§§") 
 (if 
   (not(setq objSet(ssget "_I"))) 
   (setq objSet(ssget)) 
   ); end if 
  (if objSet 
    (progn 
      (ssadd (vlax-vla-object->ename VLAOBJ) objSet) 
      (setq objSet 
       (mapcar 'vlax-ename->vla-object 
                    (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex objSet))))) 
      (foreach obj objSet 
   (vla-GetBoundingBox obj 'MinPt 'MaxPt) 
    (setq mnPt(vlax-safearray->list MinPt) 
     mxPt(vlax-safearray->list MaxPt) 
     miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt)))      
     )
     (if (vlax-method-applicable-p obj 'ScaleEntity)
     (if 
      (vl-catch-all-error-p 
   (vl-catch-all-apply 'vla-ScaleEntity 
     (list obj(vlax-3D-Point (mapcar '+ miPt BASEPT)) sm:scale))) 
      (setq errCount(1+ errCount)) 
      )
       )
   ); end foreach 
   (princ(strcat "\n" (itoa errCount) " объектов на блокированном слое! ")) 
   ) 
      ); if objset 
    (setq Flg nil) 
  ); end while 
  ))(princ))

[Kseon]

Перезагрузил комп, и программа пошла. Видимо действительно был глюк.
Спасибо VVA, всё работает. Кнопочку попозжей сделаю.
Итого классных ЛИСПов, у меня уже набралось шесть.

[Джин]

Респект широченный VVA. Долго ждал, и ... значится не напрасно

[Vova]

На эту старую тему дана свежая ссылка, поэтому поднимаю ее

Сообщение от Kseon За две минуты не получится, потому как нужно сначала понавставлять новые по тем же координатам, а потом стереть старые. .

Вот аналогия. Из заключения к книге AutoCAD Язык макрокоманд и создание кнопок

Главной задачей является научить пользователя самому строить команды под себя, а также очень быстро, в течение нескольких минут, составить временную команду для выполнения одноразовой рутинной операции. Как-то к автору обратился сослуживец с просьбой что-нибудь придумать для облегчения его работы. На большом чертеже в разных местах была установлена серия объектов, которую надо было изменить следующим образом: один объект удалить, а находящий здесь же блок с атрибутом перекрасить в другой цвет. То есть предстояло поочередное применение трех команд Erase (Стереть), Eattedit (Атредакт) и Properties (Окносв). Изменить цвет слоя не представлялось возможным. Надо было действовать “One by one”, то есть обрабатывать один объект за другим. Скучная работа. На выполнение операции с одной группой объектов надо было затратить 14 щелчков мыши да еще копаться в диалоговом окне Enchanced Attribute Editor (Редактор атрибутов) и в окошке Color Control (Цвета), подбирая нужный цвет. Я поставил на одну кнопку команды Erase (Стереть) Attedit ( Атред), наше [3-10] и Change (Изменить), видоизмененная часть нашего [12-11], внес некоторые поправки. Теперь на всю операцию надо было затратить всего три щелчка, если считать первым вызов команды. И заняло это всего 5 минут!

[posetitel]

подниму немного тему.
А есть такая программа, которая масштабирует примитивы, как например в "СПДС график" работает панелька масштабов, т.е. не относительно одной определенной точки, а относительно привязанных точек примитива.

[Krieger]

Команда "_objectscale"

[posetitel]

не работает на примитивах, пишет, что отсутствуют "аннотативные" объекты
чтобы было понятнее, хочу увеличивать объекты СПДС extension.