[gumel]

Добрый день!
Имеется AutoCAD 2006, есть задача частого копирования объектов с переносом их потом на другой слой.
В общем CopyToLayer у меня нет, прошу помощи.

Вообще мне бы хотелось выполнения копирования с переносом новых объектов на текущий слой.
Заранее благодарен.

[TararykovDG]

Сообщение от gumel Вообще мне бы хотелось выполнения копирования с переносом новых объектов на текущий слой. Заранее благодарен.

Тогда Вам сюда

[gumel]

Вы хотите сказать, что задача трудная и требует вознаграждения?

[gomer]

просто здесь обсуждаются приемы программирования, а не заказ программ

[gumel]

Да блин, я все конечно понимаю ))) Заказ Программ ! (скажете тоже)

Я так то тоже знаком с программированием не понаслышке, какая нафик программа??, так функция или даже макрос... или я ошибаюсь?

[Alan]

Сообщение от gumel Имеется AutoCAD 2006, есть задача частого копирования объектов с переносом их потом на другой слой. В общем CopyToLayer у меня нет, прошу помощи.

А чем не устраивает эта команда (CopyToLayer) из Express Tools?

[gumel]

стоп, я думал, что CopyToLayer появилась в более поздних модификациях AutoCAD'а..

[Alan]

Сообщение от gumel стоп, я думал, что CopyToLayer появилась в более поздних модификациях AutoCAD'а..

Они появились начиная с версии 2002, под именем etv1-9.exe.

[gumel]

Alan, точно, ты прав!
Поставил ET, copy to layer - есть, но работа с этой командой (в моем случае) не удобна...
Т.е. приходиться выбирать слой, потом нажимать ОК, в тот момент, когда хочется указать уже базовую точку )))

вот, нашел где то:

Код:

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

 ;copy all selected objects to current layer
;alan thompson
(defun c:CTC (/ ss ssl cnt ssn sse pt)
(vl-load-com)
(setq ss (ssget))
(if ss
    (progn
        (command "undo" "begin")
        (setq ssl (sslength ss))
        (setq cnt 0)
        (repeat
            ssl
            (setq ssn (ssname ss cnt))
            (setq sse (entget ssn))
            (setq pt (cdr (assoc 10 sse)))
            (command "_copy" ssn "" pt pt)
            (vla-put-layer (vlax-ename->vla-object (entlast)) (getvar "clayer"))
            (setq cnt (1+ cnt))
        ); repeat
        (command "undo" "end")
    );progn
);if ss
(princ)
); defun

Выполняется копирование объектов без указания базовой точки (там где было, там и осталось) на текущий слой
нужно что то изменить в строках

Код:

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

 (setq pt (cdr (assoc 10 sse)))
(command "_copy" ssn "" pt pt)

может и еще где то...

Хотелось бы чтобы новая команда не отличалась от стандартной команды COPY, с точки зрения "манипуляций".

[TararykovDG]

Код:

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

 (defun c:CTL()
  (vl-load-com)
  ((lambda(act_doc prew_nbr)
     (vla-StartUndoMark act_doc)
     ((lambda(nbr)
	(if (and nbr
		 (not (vl-catch-all-error-p nbr))
		 )
	  ((lambda(base_point)
	     (if (and base_point
		      (not (vl-catch-all-error-p base_point))
		      )
	       ((lambda(second_point clayer)
		  (if (and second_point
			   (not (vl-catch-all-error-p second_point))
			   )
		    (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex nbr)))
		      (if (vl-cmdf "_.copy" item "" base_point second_point)
			(vla-put-layer (vlax-ename->vla-object (entlast)) clayer)
			)
		      )
		    )
		  )
		 (vl-catch-all-apply 'getpoint
	           (list "\nВторая точка: ")
	           )
		 (getvar "clayer")
		 )
	       )
	     )
	    (vl-catch-all-apply 'getpoint
	      (list "\nБазовая точка: ")
	      )
	    )
	  )
	)
       (if prew_nbr
	 prew_nbr
	 (vl-catch-all-apply 'ssget)
	 )
       )
     (vla-EndUndoMark act_doc)
     )
    (vla-get-activedocument (vlax-get-acad-object))
    (cadr (ssgetfirst))
    )
  (princ)
  )

[Дима_]

Сообщение от TararykovDG (vl-cmdf "_.copy" item "" base_point second_point)

Offtop: Ну Семен Семеныч - или (vla-move (vla-copy ...)...) - что правильней - или привязки со всеми вытекающими

[TararykovDG]

Сообщение от Дима_ Offtop: Ну Семен Семеныч - или (vla-move (vla-copy ...)...) - что правильней - или привязки со всеми вытекающими

(vla-move (vla-copy ...)...) конечно правильнее, но привязки мне кажется тут не повлияют. base_point и second_point получены getpoint'ом и уже там сработали привязки если они были включены, причем при указании точек пользователь сам проконтролировала привязки.

[Дима_]

юзер может между точками "зумануть" и командные привязки привяжутся куда бог пошлет

[gomer]

эй, а где мое сбщ??? В общем, я так понимаю юзеру нужна вижуальность, а в таком случае нужно делать нехилую проверку на баобабовость...

[gumel]

TararykovDG, спасибо тебе огромное! Задача решается, конечно не хватает "вижуальности", но в принципе и так неплохо ))

p.s. Блин, я бы рад чего нибудь добавить/изменить в этом коде, но, к сожалению, LISP никак не идет... Сам синтаксис, куча скобок и т.п. меня сбивают с толку, и не дают сосредоточится на усвоении чего либо. Признаю, что я не прикладывал много усилий на изучение LISP'а, поскольку не возникало особой необходимости в этом. Пишу на Delphi (непрофессионально), делал приложения, которые связываются с AutoCAD'ом (производят анализ начерченного, делают промежуточные вычисления и т.п.), пробовал себя в VBA под AutoCAD, - тоже не особо понравилось.. Наверное тут дело привычки и потребностей. В любом случае я ВАМ премного благодарен! СПАСИБО !!!

[TararykovDG]

Сообщение от gomer В общем, я так понимаю юзеру нужна вижуальность

Сообщение от gumel конечно не хватает "вижуальности"

Ну, можно и "вижуальности" добавить

Код:

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

 (defun c:CTL()
  (vl-load-com)
  ((lambda(act_doc prew_nbr clayer last_obj)
     (vla-StartUndoMark act_doc)
     ((lambda(nbr)
	(if (and nbr
		 (not (vl-catch-all-error-p nbr))
		 )
	  (progn
	    (vl-cmdf "_.copy" nbr "")
	    (if (while (= (getvar "CMDACTIVE") 1) (vl-cmdf pause))
	      (while (setq last_obj (entnext last_obj))
		(vla-put-layer (vlax-ename->vla-object last_obj) clayer)
		)
	      )
	    )
	  )
	)
       (if prew_nbr
	 prew_nbr
	 (vl-catch-all-apply 'ssget)
	 )
       )
     (vla-EndUndoMark act_doc)
     )
    (vla-get-activedocument (vlax-get-acad-object))
    (cadr (ssgetfirst))
    (getvar "clayer")
    (entlast)
    )
  (princ)
  ); end CTL

[gumel]

TararykovDG, ну ты вообще - СУПЕРПИЛОТ !!! )) спасибо огромное !