[Red Nova]

Скажем копируем оси. Мы знаем расстояние между соседними осями, но copy устроен так, что надо каждый раз отсчитывать координату от базовой точки. Может есть такая программа позволяющая при многократном копировании передвигать базовую точку вместе с копией объекта?

[VVA]

Piton, При наличиии Express Tools

Код:

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

(defun c:nc (/            selset       start        next
                   fun_get-from-last         *lastent*    adoc
                   _cmdecho
                   )

  (defun fun_get-from-last (ent / tmp res)
    (setq res (ssadd))
    (while (setq tmp (entnext ent))
      (setq res (ssadd tmp res)
            ent tmp
            ) ;_ end of setq
      ) ;_ end of while
    res
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (setq selset (ssget "_:L"))
      (= (type (setq
                 start (vl-catch-all-apply
                         '(lambda () (getpoint "\nНачальная точка <Отмена> : "))
                         ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (setq *lastent* (entlast)
             _cmdecho  (getvar "cmdecho")
             ) ;_ end of setq
       (setvar "cmdecho" 0)
       (while
         (= (type (setq next (vl-catch-all-apply
                               '(lambda ()
				  (acet-ss-drag-move selset start "\nСледующая точка <Отмена> : " nil)
                                  ;(getpoint start "\nСледующая точка <Отмена> : ")
                                  ) ;_ end of lambda
                               ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'list
            ) ;_ end of =
          (vl-cmdf "_.copy" selset "" start next)
          (setq start     next
                selset    (fun_get-from-last *lastent*)
                *lastent* (entlast)
                ) ;_ end of setq
          ) ;_ end of while
       ) ;_ end of progn
     ) ;_ end of if
  (if _cmdecho
    (setvar "cmdecho" _cmdecho)
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Piton]

VVA Спасибо. То что нужно

[Red Nova]

Почему-то при работе лиспа выходит из строя polar tracking. Хотя возможно это идет из express tools..

[gest]

VVA, не подскажешь почему расстояние между копиями неправильно идет?

[Piton]

Такая же проблема. То нормально работает, то на неправильные расстояния копирует.

[VVA]

Много воды утекло. gest, Piton, думаю это проблемы aset-ss-drag-move
Попробуйте альтернативный вариант

Код:

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

(defun c:nc ( / ss start next adoc _cmdecho oBjLst)
  ;;;New Copy
  ;;;Alternative copy альтернативное копирование
  ;;; http://forum.dwg.ru/showthread.php?p=519958#post519958
;;; Иногда хочется иметь такую функцию, чтобы при копировании объекта, при вводе расстояния оно 
;;;откладывалось не от исходного объекта, как в стандартной функции, а от только что скопированного.
;;;при многократном копировании базовая точка передвигается вместе с копией объекта
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (setq ss (ssget "_:L"))
      (= (type (setq
                 start (vl-catch-all-apply
                         '(lambda () (getpoint "\nНачальная точка <Отмена> : "))
                         ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (setq  _cmdecho  (getvar "cmdecho")) ;_ end of setq
       (setvar "cmdecho" 0)
   ;;;       (setq oBjLst  (mapcar 'vlax-ename->vla-object
;;;      (vl-remove-if 'listp
;;;        (mapcar 'cadr
;;;          (ssnamex ss)))))
;;; (mapcar 'vla-copy oBjLst)
       (command "_.COPY" ss "" "@" "@")
       (while
         (= (type (setq next (vl-catch-all-apply
                               '(lambda ()
                                  (princ "\nСледующая точка. Отмена ESC : ")
				  (command "_.MOVE" ss "" start pause)
                                  (getvar "LASTPOINT")
                                  ;(getpoint start "\nСледующая точка <Отмена> : ")
                                  ) ;_ end of lambda
                               ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'list
            ) ;_ end of =
          ;;(mapcar 'vla-copy oBjLst)
          (command "_.COPY" ss "" "@" "@")
          (setq start     next) ;_ end of setq
          ) ;_ end of while
       (command "_.ERASE" ss "")
       ) ;_ end of progn
     ) ;_ end of if
  (if _cmdecho
    (setvar "cmdecho" _cmdecho)
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  )

[gest]

Спасибо вроде теперь все работает нормально.

[Red Nova]

Пора обновить, рад что теперь есть корректный вариант

[Piton]

Не правильно работает при копировании текст содержащий "field".

[VVA]

Piton, Немного отредактировал код в #26. Пробуйте

[Piton]

VVA Спасибо - работает как надо.