Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Добавить префикс к вставляемым блокам

Добавить префикс к вставляемым блокам

Ответ
Поиск в этой теме
Непрочитано 25.04.2017, 00:33 #1
Добавить префикс к вставляемым блокам
Spriteq
 
Регистрация: 24.04.2017
Сообщений: 4

Здравствуйте уважаемые знатоки )
Нашёл в интернете замечательный код, попытался переделать его под себя, но моих скромных знаний не хватает, помогите пожалуйста.
Программа вставляет все чертежи из выбранной папки на один лист, но у меня в чертежах блоки имеют одинаковые названия. Нужно добавить префикс в имена всех вставляемых блоков. Префикс- имя файла из которого они вставлены.
Пытался добавить сам, но не смог получить имя файла из которого вставляются блоки и переименовать только вставляемые блоки, переименовываются все блоки в чертеже.

Исходный код:
Код:
[Выделить все]
 ;Insert DWG from a folder as blocks
;updates by CAD Studio
(defun c:InsertBlks (/ d doc lst pt pt1 dir b blk blkn ex xx)
 (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if
    (and (setq
       dir (vl-filename-directory
         (getfiled "Select a DWG for folder" (getvar 'dwgprefix) "dwg" 8)
           )
     )
     (setq lst (vl-directory-files dir "*.dwg"))
	 (setq xx (princ (strcat "\n" (itoa (length lst)) " blocks found")))
     (setq pt1 (getpoint "\nSelect ins.point for first block: "))
     (setq d
        (distance (getpoint pt1 "\nSelect distance to space blocks (or 0,0): ")
              pt1
        )
     )
	 (setq ex (= "Y" (strcase (getstring "\nExplode inserted blocks? [Y/N] <N>: "))) xx T)
    )
     (foreach b    lst
	   (princ (strcat "\n" b " "))
       (setq blk (vla-insertblock
       (if (= (getvar 'cvport) 1)
         (vla-get-paperspace doc)
         (vla-get-modelspace doc)
       )
     (vlax-3d-point (setq pt1 (polar pt1 0.0 d)))
     (strcat dir "\\" b)
     1
     1
     1
     0.0
       ));insert, setq
	  (if ex (progn
	    (princ " exploding")
	    (setq blkn (vla-get-effectivename blk))
		(vl-catch-all-apply 'vla-explode (list blk)) (vl-catch-all-apply 'vla-delete (list blk))
		(vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-blocks doc) blkn)))
	  ))
    ); for
  )
  (princ "Done.")
  (princ)
)
Изменённый код:
Код:
[Выделить все]
 ;Insert DWG from a folder as blocks
;updates by CAD Studio
(defun c:InsertBlks (/ d doc lst pt pt1 dir b blk blkn ex xx Blocks *error* cm r ss int sn sfx kw bks nam)
 (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if
    (and (setq
       dir (vl-filename-directory
         (getfiled "Select a DWG for folder" (getvar 'dwgprefix) "dwg" 8)
           )
     )
     (setq lst (vl-directory-files dir "*.dwg"))
	 (setq xx (princ (strcat "\n" (itoa (length lst)) " blocks found")))
     (setq pt1 (getpoint "\nSelect ins.point for first block: "))
     (setq d
        (distance (getpoint pt1 "\nSelect distance to space blocks (or 0,0): ")
              pt1
        )
     )
	 (setq ex (= "Y" (strcase (getstring "\nExplode inserted blocks? [Y/N] <N>: "))) xx T)
    )
     (foreach b    lst
	   (princ (strcat "\n" b " "))
       (setq blk (vla-insertblock
       (if (= (getvar 'cvport) 1)
         (vla-get-paperspace doc)
         (vla-get-modelspace doc)
       )
     (vlax-3d-point (setq pt1 (polar pt1 0.0 d)))
     (strcat dir "\\" b)
     1
     1
     1
     0.0
       ));insert, setq
	  (if ex (progn
	    (princ " exploding")
	    (setq blkn (vla-get-effectivename blk))
		(vl-catch-all-apply 'vla-explode (list blk)) (vl-catch-all-apply 'vla-delete (list blk))
		(vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-blocks doc) blkn)))
	  ))
;;; 		Tharwat 31. Oct. 2012 			;;;
;;;   Rename selected or All Blocks as User's inputs    ;;;
(or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
(setq Blocks (vla-get-blocks acdoc))
(setq cm (getvar 'cmdecho))
(defun *error* (x)
(if cm
(setvar 'cmdecho cm)
)
(vla-EndUndoMark acdoc)
(princ "\n")
(princ "\n *Cancel*:")
)
(if (and (not (eq (setq sfx "1") ""))
(setq r (snvalid sfx))
(progn (initget "Selected All")
(setq kw (cond ("All")
("Selected")
)
)
)
)
(if (eq kw "All")
(progn (vla-StartUndoMark acdoc)
(vlax-for x Blocks (vl-catch-all-apply 'vla-put-name (list x (strcat sfx (vla-get-name x)))))
(vla-EndUndoMark acdoc)
)
(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
(progn (vla-StartUndoMark acdoc)
(setvar 'cmdecho 0)
(repeat (setq int (sslength ss))
(setq sn (ssname ss (setq int (1- int))))
(setq nam (cdr (assoc 2 (entget sn))))
(if (not (member nam bks))
(progn (vl-cmdf "_.-rename" "B" nam (setq nam (strcat sfx nam))) (setq bks (cons nam bks)))
)
)
(vla-EndUndoMark acdoc)
(setvar 'cmdecho cm)
)
)
)
(cond ((not sfx) (princ "\n Cancelled by user "))
(t (princ "\n Cancelled by user "))
)
)
    ); for
  )
  (princ "Done.")
  (princ)
)

Последний раз редактировалось Spriteq, 25.04.2017 в 16:37.
Просмотров: 4374
 
Непрочитано 25.04.2017, 01:48
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от Spriteq Посмотреть сообщение
но не смог получить имя файла из которого вставляются блоки
насколько вижу из исходного кода - в строке 12 получаете список файлов в переменной lst, соответственно в строке 22 в переменной b должно быть искомое имя текущего файла.
Сергей812 вне форума  
 
Непрочитано 25.04.2017, 13:51
#3
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Rename A Pasted Block+
поиск autocad lisp rename block
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 25.04.2017, 18:59
#4
Spriteq


 
Регистрация: 24.04.2017
Сообщений: 4


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
насколько вижу из исходного кода - в строке 12 получаете список файлов в переменной lst, соответственно в строке 22 в переменной b должно быть искомое имя текущего файла.
Заменил на (if (and (not (eq (setq sfx (vla-get-name b)) "")) вставляется только один чертёж и получаю " *Cancel*:"
Не уверен, правильно ли я получаю имя из переменной b


Код:
[Выделить все]
  ;Insert DWG from a folder as blocks
;updates by CAD Studio
(defun c:InsertBlks (/ d doc lst pt pt1 dir b blk blkn ex xx Blocks *error* cm r ss int sn sfx kw bks nam)
 (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if
    (and (setq
       dir (vl-filename-directory
         (getfiled "Select a DWG for folder" (getvar 'dwgprefix) "dwg" 8)
           )
     )
     (setq lst (vl-directory-files dir "*.dwg"))
	 (setq xx (princ (strcat "\n" (itoa (length lst)) " blocks found")))
     (setq pt1 (getpoint "\nSelect ins.point for first block: "))
     (setq d
        (distance (getpoint pt1 "\nSelect distance to space blocks (or 0,0): ")
              pt1
        )
     )
	 (setq ex (= "Y" (strcase (getstring "\nExplode inserted blocks? [Y/N] <N>: "))) xx T)
    )
     (foreach b    lst
	   (princ (strcat "\n" b " "))
       (setq blk (vla-insertblock
       (if (= (getvar 'cvport) 1)
         (vla-get-paperspace doc)
         (vla-get-modelspace doc)
       )
     (vlax-3d-point (setq pt1 (polar pt1 0.0 d)))
     (strcat dir "\\" b)
     1
     1
     1
     0.0
       ));insert, setq
;;; 		Tharwat 31. Oct. 2012 			;;;
;;;   Rename selected or All Blocks as User's inputs    ;;;
(or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
(setq Blocks (vla-get-blocks acdoc))
(setq cm (getvar 'cmdecho))
(defun *error* (x)
(if cm
(setvar 'cmdecho cm)
)
(vla-EndUndoMark acdoc)
(princ "\n")
(princ "\n *Cancel*:")
)
(if (and (not (eq (setq sfx (vla-get-name b)) ""))
(setq r (snvalid sfx))
(progn (initget "Selected All")
(setq kw (cond ("All")
("Selected")
)
)
)
)
(if (eq kw "All")
(progn (vla-StartUndoMark acdoc)
(vlax-for x Blocks (vl-catch-all-apply 'vla-put-name (list x (strcat sfx (vla-get-name x)))))
(vla-EndUndoMark acdoc)
)
(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
(progn (vla-StartUndoMark acdoc)
(setvar 'cmdecho 0)
(repeat (setq int (sslength ss))
(setq sn (ssname ss (setq int (1- int))))
(setq nam (cdr (assoc 2 (entget sn))))
(if (not (member nam bks))
(progn (vl-cmdf "_.-rename" "B" nam (setq nam (strcat sfx nam))) (setq bks (cons nam bks)))
)
)
(vla-EndUndoMark acdoc)
(setvar 'cmdecho cm)
)
)
)
(cond ((not sfx) (princ "\n Cancelled by user "))
(t (princ "\n Cancelled by user "))
)
)
	  (if ex (progn
	    (princ " exploding")
	    (setq blkn (vla-get-effectivename blk))
		(vl-catch-all-apply 'vla-explode (list blk)) (vl-catch-all-apply 'vla-delete (list blk))
		(vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-blocks doc) blkn)))
	  ))
    ); for
  )
  (princ "Done.")
  (princ)
)

Цитата:
Сообщение от VVA Посмотреть сообщение
Rename A Pasted Block+
поиск autocad lisp rename block
По первой ссылке всё то же, нужно выделить блоки в мануале. К сожалению мой поиск в интернете ничего не дал, я нашёл много программ которые выделяют все блоки или пользователь выделяет блоки, но я не знаю как их правильно вставить в эту программу, чтобы блоки выделялись сами, только те, которые только что вставились.
Spriteq вне форума  
 
Непрочитано 26.04.2017, 18:40
#5
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Spriteq Посмотреть сообщение
чтобы блоки выделялись сами, только те, которые только что вставились
Сами не выделятся. Нужно собирать, например как здесь Отслеживание объектов появившихся после pasteclip в посте #2
1. Перед вставкой dwg файлов как блоков запоминаешь последнюю метку (ф-ция mip:mark по ссылке)
2. Вставляешь блоки.
3. Проходишься от запомненной последней метки и "собираешь" вновь появившиеся объекты в набор (ф-ция (mip:get-last-ss) по ссылке)
4. Проходишься циклом по полученному набору и скармливаешь блоки поштучно команде _rename
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.04.2017, 09:32
#6
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 163


Вставлять как внешнюю ссылку с внедрением не подойдёт?
frostmourn вне форума  
 
Автор темы   Непрочитано 27.04.2017, 14:33
#7
Spriteq


 
Регистрация: 24.04.2017
Сообщений: 4


Цитата:
Сообщение от frostmourn Посмотреть сообщение
Вставлять как внешнюю ссылку с внедрением не подойдёт?
Тогда у слоёв и всего остального тоже появится префикс. Если вставить много файлов, то merge слоёв с целью убрать у них префикс займёт очень много времени. Можно ли при внедрении внешней ссылки добавить префикс только к блокам ?

Цитата:
Сообщение от VVA Посмотреть сообщение
Сами не выделятся. Нужно собирать, например как здесь Отслеживание объектов появившихся после pasteclip в посте #2
1. Перед вставкой dwg файлов как блоков запоминаешь последнюю метку (ф-ция mip:mark по ссылке)
2. Вставляешь блоки.
3. Проходишься от запомненной последней метки и "собираешь" вновь появившиеся объекты в набор (ф-ция (mip:get-last-ss) по ссылке)
4. Проходишься циклом по полученному набору и скармливаешь блоки поштучно команде _rename
Спасибо, попробую.
Spriteq вне форума  
 
Непрочитано 27.04.2017, 16:48
#8
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,481
Отправить сообщение для maratovich с помощью Skype™


Что то я не особо понял цели, нужно :
- собрать всё в один файл, без разницы каким методом, но с разными именами блоков ?
- собрать но имя блоков с префиксом имени файла ?

Из компаса экспортируете ?
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Автор темы   Непрочитано 27.04.2017, 18:56
#9
Spriteq


 
Регистрация: 24.04.2017
Сообщений: 4


Цитата:
Сообщение от maratovich Посмотреть сообщение
Что то я не особо понял цели, нужно :
- собрать всё в один файл, без разницы каким методом, но с разными именами блоков ?
- собрать но имя блоков с префиксом имени файла ?

Из компаса экспортируете ?
Метод действительно не важен, главное, что бы работало.
В файлах которые нужно собрать много блоков, по разному 50-200, в основном блоки называются одинаково во всех файлах, это создаёт проблемы если собрать их все вместе, поэтому нужен какой-то префикс к именам блоков даже не обязательно имя файла, можно просто порядковый номер. Все блоки из первого файла с номером 1, все блоки из второго с номером 2 итд. Слои тоже имеют одинаковый имена, слои нужно склеить, им префиксы не нужны.
Файлы экспортированы из Зукена.
Spriteq вне форума  
 
Непрочитано 29.04.2017, 09:19
1 | #10
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,481
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от Spriteq Посмотреть сообщение
Метод действительно не важен, главное, что бы работало.
Тогда без проблем - в Реверс, внизу нажать "Собрать в один фай", выбрать кучу файлов, выбрать настройки, нажать "Собрать" и усё.
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Непрочитано 02.05.2017, 15:41
1 | #11
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 163


Spriteq, пробуйте. Минимально доработал, ориентировано на простые блоки.
Вложения
Тип файла: lsp InsertBlks.lsp (13.7 Кб, 14 просмотров)
frostmourn вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Добавить префикс к вставляемым блокам

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как добавить префикс к однострочному тексту в AutoCAD 2016 andrey_artphoto AutoCAD 5 27.05.2015 17:11
Как добавить символ катета сварного шва в шрифт shx? МишаИнженер AutoCAD 9 16.09.2013 13:00
Добавить к пикетажу ПК gunkin AutoCAD 1 11.09.2012 11:03
Помогите в лире добавить ж/б балки Maria Лира / Лира-САПР 1 15.05.2006 06:58