• Ronny
  • Восстановленный участник
  • На форуме с 18 октября 2004г.
  • Сообщений: 32
  • Спасибо: 0

Тема: Нужна программа: совмещение точек вставки блоков

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

  • Alan
  • Активный участник
  • Откуда: Украина / Киев
  • На форуме с 2 апреля 2002г.
  • Сообщений: 1,345
  • Спасибо: 15

Re: Нужна программа: совмещение точек вставки блоков

Так как точно не представил Вашу задачу, даю два варианта:
1.Без программы это наверное можно решить используя объектную привязку.
2.В программе задать т.вставки

(setq p1 (getpoint "\Укажите т.вставки"))
(COMMAND "_.INSERT" BlocName1 p1 ....
(COMMAND "_.INSERT" BlocName2 p1 ....
(COMMAND "_.INSERT" BlocNameNN p1 ....

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Нужна программа: совмещение точек вставки блоков

Зачем такое, не очень понятно, но тем не менее:

(defun c:mcblk (/ _answer_)
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc*
       (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of setq
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (while (not _answer_)
    (blocks-make-complanar)
    (initget "Да Нет Yes No _ Y N Y N")
    (setq _answer_ (getkword "\n Достаточно [Да/Нет] <Нет>? : "))
    (if    (= _answer_ "N")
      (setq _answer_ nil)
      ) ;_ end of if
    ) ;_ end of while
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun
(defun c:cblk ()
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc*
       (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of setq
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (blocks-make-complanar)
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun
(defun blocks-make-complanar (/ block_source block_dest)
  (setq    block_source (_kpblc-get-ent-no-error
               "Укажите блок, с которого брать точку вставки : "
               ) ;_ end of _kpblc-get-ent-no-error
    block_dest   (_kpblc-get-ent-no-error
               "Укажите блок, для которого надо установить точку вставки : "
               ) ;_ end of _kpblc-get-ent-no-error
    ) ;_ end of setq
  (if (and block_source
       block_dest
       (= (cdr (assoc 0 (entget (car block_source)))) "INSERT")
       (= (cdr (assoc 0 (entget (car block_dest)))) "INSERT")
       ) ;_ end of and
    (vla-put-insertionpoint
      (vlax-ename->vla-object (car block_dest))
      (vla-get-insertionpoint
    (vlax-ename->vla-object (car block_source))
    ) ;_ end of vla-get-InsertionPoint
      ) ;_ end of vla-put-InsertionPoint
    ) ;_ end of if
  ) ;_ end of defun
;|=============================================================================
*    Безошибочный выбор примитива. Возвращается список из имени примитива и
* точки выбора в WCS.
*    Параметры вызова:
*    msg - сообщение, которое должно печататься во время запроса объекта
*    Примеры вызова:
(_kpblc-ent-get-no-error "Выбор объекта : ")    ; (<Entity name: 7efe1698> (5.23163 5.13227 0.0))
***
* источник : ruCAD
=============================================================================|;
(defun _kpblc-get-ent-no-error (msg / ent)
  (setvar "errno" 0)
  (if (not msg)
    (setq msg "")
    ) ;_ end of if
  (setq msg (vl-string-trim "\n" msg))
  (while (and
       (not (setq ent (entsel (strcat "\n" msg))))
       (equal 7 (getvar "errno"))    ; ошибка выбора
       ) ;_ end of and
    (setvar "errno" 0)
    ) ;_ end of while
  (cond
    ((equal (getvar "errno") 52)    ; пустой выбор
     nil
     )
    (t
     (list (car ent) (trans (cadr ent) 1 0))
     )
    ) ;_ end of cond
  ) ;_ end of defun

Функция cblk для однократного применения, mcblk - для многократного

  • Ronny
  • Восстановленный участник
  • На форуме с 18 октября 2004г.
  • Сообщений: 32
  • Спасибо: 0

Re: Нужна программа: совмещение точек вставки блоков

Спасибо kpblc, ты как всегда, в точку!
Единственное, что можно пожелать, чтобы исходный блок подсвечивался при выделении(для уверенности, что "попал" в блок. Сейчас это контролируется по командной строке, что не совсем удобно). Тогда эта прога будет совсем конфеткой. :)

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Нужна программа: совмещение точек вставки блоков

> Ronny
Если речь идет о 2 (двух) блоках - то ведь есть объектная привязка "_Insertion" ("Твставки")...

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Нужна программа: совмещение точек вставки блоков

> Ronny
Попробуй заменить _kpblc-get-ent-no-error на 

;|=============================================================================
*    Безошибочный выбор примитива. Возвращается список из имени примитива и
* точки выбора в WCS.
*    Параметры вызова:
*  msg - сообщение, которое должно печататься во время запроса объекта
*    Примеры вызова:
(_kpblc-ent-get-no-error "Выбор объекта : ")  ; (<Entity name: 7efe1698> (5.23163 5.13227 0.0))
***
* источник : ruCAD
=============================================================================|;
(defun _kpblc-get-ent-no-error (msg / ent selset)
  (setvar "errno" 0)
  (if (not msg)
    (setq msg "")
    ) ;_ end of if
  (setq msg (vl-string-trim "\n" msg))
  (while (and
           (not (setq ent (entsel (strcat "\n" msg))))
           (equal 7 (getvar "errno"))   ; ошибка выбора
           ) ;_ end of and
    (setvar "errno" 0)
    ) ;_ end of while
  (cond
    ((equal (getvar "errno") 52)        ; пустой выбор
     nil
     )
    (t
     (list (car ent) (trans (cadr ent) 1 0))
     )
    ) ;_ end of cond
  (ssadd selset)
  (setq selset (ssadd (car ent) selset))
  (sssetfirst selset selset)
  ent
  ) ;_ end of defun

Скажу честно, не проверял на работоспособность. Если работает некорректно, обязательно скажи, попробую протестировать

  • Ronny
  • Восстановленный участник
  • На форуме с 18 октября 2004г.
  • Сообщений: 32
  • Спасибо: 0

Re: Нужна программа: совмещение точек вставки блоков

> kpblc
После замены, получил такой результат:
Command: CBLK
Укажите блок, с которого брать точку вставки : *Cancel*
bad argument type: lentityp nil
и действие команды на этом заканчивается.

> Владимир Громов
Допустим имеем два блока в чертеже.
Идем в рукопашную:
1. Выделил 1-й блок
2. Выделил 2-й блок
3. Ухватился за точку вставки второго блока
4. Тяну второй блок к первому, встречая на своем пути препятствия в виде привязок к любым другим рядомрасположенным объектам.(мой osmode=4775, так что ловлю всё подряд)
Используем довески(в очередной раз большой респект Всем кто готов Нас(юзеров) услышать и прийти на помощь):
не в счет:
гружу довесок
вешаю на кнопку через acad.pgp
1.Запускаю его(делается почти мгновенно, без отвлекания на клавку)
2. Выделяю 1-й блок
3. Выделяю 2-й блок
всё.(хотя не мне это Вам, Владимир, объяснять)
Выигрыш по времени и удовольствию существенные. :)

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Нужна программа: совмещение точек вставки блоков

> Ronny
Да понятно, так быстрее получится. Все дело в том, что у меня-то больше 2-3 постоянных привязок не бывает, а иногда и вообще ни одной.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Нужна программа: совмещение точек вставки блоков

Ну правильно, у крысы прищемило хвост, оно и бросается чем ни попадя:) Попробуй так:

(defun c:mcblk (/ _answer_)
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc*
           (vla-get-activedocument (vlax-get-acad-object))
          ) ;_ end of setq
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (while (not _answer_)
    (blocks-make-complanar)
    (initget "Да Нет Yes No _ Y N Y N")
    (setq _answer_ (getkword "\n Достаточно [Да/Нет] <Нет>? : "))
    (if (= _answer_ "N")
      (setq _answer_ nil)
      ) ;_ end of if
    ) ;_ end of while
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun
(defun c:cblk ()
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc*
           (vla-get-activedocument (vlax-get-acad-object))
          ) ;_ end of setq
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (blocks-make-complanar)
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun
(defun blocks-make-complanar (/ block_source block_dest)
  (setq block_source (_kpblc-get-ent-no-error
                       "Укажите блок, с которого брать точку вставки : "
                       ) ;_ end of _kpblc-get-ent-no-error
        block_dest   (_kpblc-get-ent-no-error
                       "Укажите блок, для которого надо установить точку вставки : "
                       ) ;_ end of _kpblc-get-ent-no-error
        ) ;_ end of setq
  (if (and block_source
           block_dest
           (= (cdr (assoc 0 (entget (car block_source)))) "INSERT")
           (= (cdr (assoc 0 (entget (car block_dest)))) "INSERT")
           ) ;_ end of and
    (vla-put-insertionpoint
      (vlax-ename->vla-object (car block_dest))
      (vla-get-insertionpoint
        (vlax-ename->vla-object (car block_source))
        ) ;_ end of vla-get-InsertionPoint
      ) ;_ end of vla-put-InsertionPoint
    ) ;_ end of if
  ) ;_ end of defun
;|=============================================================================
*    Безошибочный выбор примитива. Возвращается список из имени примитива и
* точки выбора в WCS.
*    Параметры вызова:
*  msg - сообщение, которое должно печататься во время запроса объекта
*    Примеры вызова:
(_kpblc-ent-get-no-error "Выбор объекта : ")  ; (<Entity name: 7efe1698> (5.23163 5.13227 0.0))
***
* источник : ruCAD
=============================================================================|;
(defun _kpblc-get-ent-no-error (msg / ent selset)
  (setvar "errno" 0)
  (if (not msg)
    (setq msg "")
    ) ;_ end of if
  (setq msg (vl-string-trim "\n" msg))
  (while (and
           (not (setq ent (entsel (strcat "\n" msg))))
           (equal 7 (getvar "errno"))   ; ошибка выбора
           ) ;_ end of and
    (setvar "errno" 0)
    ) ;_ end of while
  (cond
    ((equal (getvar "errno") 52)        ; пустой выбор
     nil
     )
    (t
     (progn
       (setq selset (ssadd))
       (setq selset (ssadd (car ent) selset))
       (sssetfirst selset selset)
       (list (car ent) (trans (cadr ent) 1 0))
       ) ;_ end of progn
     )
    ) ;_ end of cond
  ) ;_ end of defun

Привел весь код, чтоб не мучиться

  • Ronny
  • Восстановленный участник
  • На форуме с 18 октября 2004г.
  • Сообщений: 32
  • Спасибо: 0

Re: Нужна программа: совмещение точек вставки блоков

Столкнулся с проблемой(уже не в первый раз).
.lsp с кодом этой программы грузится, но при вызове команды кад выдает:
Command: cblk Unknown command "CBLK".  Press F1 for help.
Вернул обратно код  > kpblc (2005-11-23 10:25:28), но ситуация повторяется(почему, не понимаю, ведь раньше первоначальный код работал) .
Пробовал на другой машине, то же самое.
Большая просьба: народ, протестируйте эту прогу и отпишите.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Нужна программа: совмещение точек вставки блоков

Странно. Специально только что проверил на голом каде (2005, 2006), нормально срабатывает (подгружал и через _.appload, и через редактор)

  • Ronny
  • Восстановленный участник
  • На форуме с 18 октября 2004г.
  • Сообщений: 32
  • Спасибо: 0

Re: Нужна программа: совмещение точек вставки блоков

> kpblc
Я пробовал и в ADT2006  и в голом 2005.
Если не затруднит, скинь исходник на renn@list.ru
Подозреваю(звучит конечно глупо) при использовании Copy-Paste происходит глюк с Notepad'ом.
Помню, просил утилиту полной очистки чертежа от групп, ответ был найден у Шапокляк https://www.caduser.ru/forum/topic14489.html ,так при хранении этого кода и последующем использовании  в ACADe, последний не до конца прогонял этот код. При использовании Word'a всё работало.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Нужна программа: совмещение точек вставки блоков

> Ronny
Ушло. А ты часом не Оперу пользуешь? У нее (по крайней мере, 8.5) есть определенные проблемы при копировании кода отсюда. Либо MSIE, либо Mozilla, либо Netscape.