Создание Динамического блока с атрибутами методами Lisp.

jackUAROBEY · 18.08.2016, 14:33

Добрый день может кто подскажет способ создания динамического блока с атрибутами.
Через фунцию vla-addAttribute получается добавить атрибут но не получается сделать фиксированное положение, а как параметр растяжения добавить вообще непонятно.

Boxa · 18.08.2016, 14:56

нсли мне не изменяет мой склероз, то ответ - создать дин блок программно нельзя. только скопировать имеющийся.

Кулик Алексей aka kpblc · 18.08.2016, 14:58

На theswamp.org, кажется, пробовали создать. Чем закончилось - увы, не помню.

jackUAROBEY · 23.08.2016, 08:21

Блин плохо.

jackUAROBEY · 09.09.2016, 13:47

Получилось динамический блок создать правда коммандными методами. Методом ActivX не получилось

Код:

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

  (defun block ( /  bsnn bsnn_ bsnn_n bsnn_n_
		p1 p2 p3 p4 p5 p6 p7 p8 p9 );создание блока отметки ОТГП    
    (setq bsnn (getvar "CELWEIGHT")
	  bsnn_ (getvar "CELTYPE")
	  bsnn_n (getvar "CECOLOR")
	  bsnn_n_ (getvar "CELTSCALE"))
    (setvar "CELWEIGHT" 70)
    (setvar "CELTYPE" "continuous")
    (setvar "CECOLOR" "bylayer")
    (setvar "CELTSCALE" 1.0)
    (setq bl_name "ОТГП") 
(setq m_koef 1)   
    (setq p1 (list 0.0 0.0 0.0))
    (setq p2 (list  (* 4.95 m_koef) (* 4.95 m_koef) 0.0))
    (setq p3 (list  (* 16.40 m_koef) (* 4.95 m_koef) 0.0))
    
    (setq p4 (list  (* 10.675 m_koef) (* 6.45 m_koef) 0.0));атрибут красные отметки
    (setq p5 (list  (* 10.675 m_koef) (* 3.45 m_koef) 0.0));атрибут черные отметки
    
    (setq p6 (list  (* 4.0 m_koef) (* 8.5 m_koef) 0.0))
    (setq p7 (list  (* 17.0 m_koef) (* 1.5 m_koef) 0.0))
    (setq p8 (list  (* -1.0 m_koef) (* 9.5 m_koef) 0.0))
    (setq p9 (list  (* 17.0 m_koef) (* -1.0 m_koef) 0.0))
    (command "_bedit" bl_name "")
    (command "_Line" p1 p2 p3 "")
    (Command "_ATTDEF" ""  "krasn" "красные отметки земли" "0,000" "_j" "_mc" P4 "0")    
    (Command "_ATTDEF" ""  "chern" "Черные отметки земли" "0,000" "_j" "_mc" P5 "0")
    (Command "_Bparameter" "_P" P1 P2 p6 "1")
    (command "_bactiontool" "_stretch" P1 P2 P6 P7 "_window" P8 P9 "")
    (command "_BCLOSE" "")
    (setvar "CELWEIGHT" bsnn)
    (setvar "CELTYPE" bsnn_)
    (setvar "CECOLOR" bsnn_n)
    (setvar "CELTSCALE" bsnn_n_)
    (princ)
    )

skkkk · 11.09.2016, 12:54

Цитата:

Сообщение от jackUAROBEY

правда коммандными методами

Лучше бы попробовать заменить "command" на "vl-cmdf", если не перестанет работать (такое может быть). Потому как данный код точно не пойдет на последних версиях Автокада, где вместо "command" появилась "command-s", которая не принимает несколько команд подряд в одних скобках.

jackUAROBEY · 13.09.2016, 10:01

Да наверно так лучше будет

Код:

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

   (defun block ( /  bsnn bsnn_ bsnn_n bsnn_n_
		p1 p2 p3 p4 p5 p6 p7 p8 p9 );создание блока отметки ОТГП    
    (setq bsnn (getvar "CELWEIGHT")
	  bsnn_ (getvar "CELTYPE")
	  bsnn_n (getvar "CECOLOR")
	  bsnn_n_ (getvar "CELTSCALE"))
    (setvar "CELWEIGHT" 70)
    (setvar "CELTYPE" "continuous")
    (setvar "CECOLOR" "bylayer")
    (setvar "CELTSCALE" 1.0)
    (setq bl_name "ОТГП")
(setq m_koef 1)    
    (setq p1 (list 0.0 0.0 0.0))
    (setq p2 (list  (* 4.95 m_koef) (* 4.95 m_koef) 0.0))
    (setq p3 (list  (* 16.40 m_koef) (* 4.95 m_koef) 0.0))
    
    (setq p4 (list  (* 10.675 m_koef) (* 6.45 m_koef) 0.0));атрибут красные отметки
    (setq p5 (list  (* 10.675 m_koef) (* 3.45 m_koef) 0.0));атрибут черные отметки
    
    (setq p6 (list  (* 4.0 m_koef) (* 8.5 m_koef) 0.0))
    (setq p7 (list  (* 17.0 m_koef) (* 1.5 m_koef) 0.0))
    (setq p8 (list  (* -1.0 m_koef) (* 9.5 m_koef) 0.0))
    (setq p9 (list  (* 17.0 m_koef) (* -1.0 m_koef) 0.0))
    (vl-cmdf "_bedit" bl_name ""
	     "_Line" p1 p2 p3 ""
	     "_ATTDEF" ""  "krasn" "красные отметки земли" "0,000" "_j" "_mc" P4 "0")
    (setvar "CECOLOR" "7")
    (vl-cmdf "_ATTDEF" ""  "chern" "Черные отметки земли" "0,000" "_j" "_mc" P5 "0"
	     "_Bparameter" "_P" P1 P2 p6 "1"
	     "_bactiontool" "_stretch" P1 P2 P6 P7 "_window" P8 P9 ""
	     "_BCLOSE" "")
    (setvar "CELWEIGHT" bsnn)
    (setvar "CELTYPE" bsnn_)
    (setvar "CECOLOR" bsnn_n)
    (setvar "CELTSCALE" bsnn_n_)
    (princ)
    )

Do$ · 14.09.2016, 23:56

Когда-то мне тоже понадобилось программно добавлять дин.блоки в чертеж. Реализовал такой способ: создавал блок вручную, помещал его в чертеж-библиотеку блоков и при необходимости использования загружал все описания блоков из библиотеки в чертеж. Потом вставлял блок, задавал значения дин.параметрам и атрибутам. Очень помогла мне в этом статья Алексея по работе с неактивным документом: http://autolisp.ru/2010/04/08/procee...tive-document/
Но у меня были такие непростые блоки, что устанешь командными методами их создавать

skkkk · 15.09.2016, 14:25

Do$, согласен, с библиотекой работать гораздо удобней, в том числе править блоки в редакторе блоков, а не в коде программы. Я организовал (по совету ShaggyDoc'a) программную вставку файла библиотеки блоков с немедленной отменой, то есть описания всех блоков в чертеже появляются, а физически он не вставляется. Только получалось так, что при очень большом весе файла библиотеки наблюдалось заметное подтормаживание работы кода. Поэтому пришлось делать несколько менее весомых файлов. И еще после выполнения кода в файле остаются описания всех блоков библиотеки, приходится чистить. При программной очистке после каждого запуска любой из функций также бывает заметно некоторое подвисание. Подумываю над тем, чтобы делать каждый блок отдельным файлом. и складывать их все в папку, прописанную в путях доступа.

Кулик Алексей aka kpblc · 15.09.2016, 15:24

skkkk, будьте проще, сядьте на пол: используй ObjectDBX и через vla-copyobjects копируй описание блока. Достаточно элементарная задача. Другой вопрос, если тебе надо переопределять уже имеющийся блок - тогда да, тогда проще всего командные методы.

Do$ · 15.09.2016, 16:51

Покопался в старых своих наработках, нарыл вот такую функцию:

Код:

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

 (defun do$-block-from-library (file name / odbx block-filename)
  ;;(do$-block-from-library "blkLib.dwg" "ПРОФИЛЬ_Отметка")
  ;;Копирует ВСЕ описания блоков из указанного чертежа file в текущий,
  ;;и проверяет наличие указанного блока name в описаниях.
  (setq	*do$-dir-path* (if *do$-dir-path*
			 *do$-dir-path*
			 ""
		       ) ;_ end of if
	file	       (strcat *do$-dir-path* "\\" file)
  ) ;_ end of setq
  (or *do$-blocks*
      (setq *do$-blocks*
	     (vla-get-Blocks
	       (vla-get-ActiveDocument (vlax-get-acad-object))
	     ) ;_ конец vla-get-Blocks
      ) ;_ конец setq
      ;;(vlax-dump-Object *do$-blocks*)
  ) ;_ конец or
  (or (tblsearch "block" name)
      (and (setq block-filename (findfile file))
	   (setq odbx (_lispru-odbx))
	   (not	(vl-catch-all-error-p
		  (vl-catch-all-apply
		    '(lambda () (vla-open odbx block-filename))
		  ) ;_ конец vl-catch-all-apply
		) ;_ конец vl-catch-all-error-p
	   ) ;_ конец not
	   (progn
	     (vl-catch-all-apply
	       '(lambda	()
		  ;;Старая версия - копировала только указанное описание блока:
		  ;|
		  (vla-copyobjects
		    odbx
		    (vlax-safearray-fill
		      (vlax-make-safearray
			vlax-vbobject
			'(0 . 0)
		      ) ;_ end of vlax-make-safearray
		      (list (vla-item (vla-get-blocks odbx)
				      name
			    ) ;_ конец vla-item
		      ) ;_ end of list
		    ) ;_ end of vlax-safearray-fill
		    *do$-blocks*
		  ) ;_ end of vla-CopyObjects
(vlax-for item *do$-blocks* (setq lst (cons (vla-get-name item) lst)))
|;
		  (vlax-for blk	(vla-get-blocks odbx)
		    (if	(not (wcmatch (vla-get-name blk) "`**"))
		      (vla-copyobjects
			odbx
			(vlax-safearray-fill
			  (vlax-make-safearray
			    vlax-vbobject
			    '(0 . 0)
			  ) ;_ end of vlax-make-safearray
			  (list blk)
			) ;_ end of vlax-safearray-fill
			*do$-blocks*
		      ) ;_ end of vla-CopyObjects
		    ) ;_ end of if
		  ) ;_ end of vlax-for
		) ;_ конец lambda
	     ) ;_ конец vl-catch-all-apply
	   ) ;_ конец progn
      ) ;_ конец and
  ) ;_ конец or
  (if odbx
    (progn
      (vlax-release-object odbx)
      (setq odbx nil)
    ) ;_ конец progn
  ) ;_ конец if
  (tblsearch "block" name)
) ;_ конец defun

Здесь:
*do$-dir-path* - это путь от какой-либо папки поддержки автокада до папки с файлом DWG (библиотека блоков).
*do$-blocks* - это коллекция описаний блоков в текущем чертеже. Запоминал глобально для увеличения быстродействия, когда вставлял блоки по одному. В том виде, в котором функция сейчас, можно заменить на локальную переменную.
_lispru-odbx - функция из статьи Алексея.
Функция проверяет наличие блока в чертеже. Если блока нет - копирует блоки из библиотеки (все, кроме анонимных).
Работает и по сей день в каких-то моих старых программах

jackUAROBEY · 20.09.2016, 15:05

Добрый день.
Почитал форум пытаюсь создать программку копирования конкретного блока из неактивного файла. Как получить список описаний блоков стороннего документа?
Начала программы взял у Кулик но как дошел до получения списка все тупик.

Код:

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

 (setq acad_object (vlax-get-acad-object))                   ; указатель на программу AutoCAD
  (setq active_document (vla-get-activedocument acad_object)) ; указатель на активный документ
  (setq model_space (vla-get-modelspace active_document)) 
  (defun _lispru-acad-version ()
    (atof (getvar "acadver"))
    )


  (defun _lispru-odbx (/)
    (cond
      ((< (_lispru-acad-version) 15.06)
       (alert
	 "ObjectDBX method not applicable\nin this AutoCAD version"
	 ) ;_ end of KPBLC-MSG-ALERT
       nil
       )
      ((= (fix (_lispru-acad-version)) 15)
       (if (not (vl-registry-read
		  "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
		  ) ;_ end of vl-registry-read
		) ;_ end of not
	 (startapp "regsvr32.exe"
		   (strcat "/s \"" (findfile "axdb15.dll") "\"")
		   ) ;_ end of startapp
	 ) ;_ end of if
       (vla-getinterfaceobject
	 (vlax-get-acad-object)
	 "ObjectDBX.AxDbDocument"
	 ) ;_ end of vla-getinterfaceobject
       )
      (t
       (vla-getinterfaceobject
	 (vlax-get-acad-object)
	 (strcat "ObjectDBX.AxDbDocument." (itoa (fix (_lispru-acad-version))))
	 ) ;_ end of vla-getinterfaceobject
       )
      ) ;_ end of cond
    )
  (setq odbx (_lispru-odbx))
  (vlax-dump-Object odbx t)

пробую вот так но чувствую что не то делаю

Код:

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

 (setq rt (cons (vla-get-blocks odbx )nil))

(setq temp (vla-copyObjects odbx
        (vlax-make-variant
	  (vlax-safearray-fill
	    (vlax-make-safearray
	      vlax-vbobject
	      (cons 0 (1- (vl-list-length rt)))
	      )
	    rt)
	  )
   model_space)
      )

Кулик Алексей aka kpblc · 20.09.2016, 15:16

Без внимательного просмотра: попробуй копировать не в пространство модели, а в коллекцию блоков текущего документа (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))

jackUAROBEY · 20.09.2016, 17:47

Все получилось спасибо всем. Очень полезная функция давно о такой думал.

frostmourn · 28.10.2016, 12:19

Можно и некомандно создать.

После запуска открываете полученный путь в проводнике. (Атрибут поломался, чинить неохота.)

roaa · 05.11.2016, 08:03

До кучи вставка описания блока из файлов dwg, dxf, dws, dwt
куча.lsp

18.08.2016, 14:33		#1
Создание Динамического блока с атрибутами методами Lisp. jackUAROBEY Проектировщик ВК Анапа Регистрация: 18.09.2014 Сообщений: 55 Добрый день может кто подскажет способ создания динамического блока с атрибутами. Через фунцию vla-addAttribute получается добавить атрибут но не получается сделать фиксированное положение, а как параметр растяжения добавить вообще непонятно. Последний раз редактировалось jackUAROBEY, 18.08.2016 в 14:50.
Просмотров: 4140

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание динамического 3D блока швеллера в AutoCAD 2014	Robenzon	Динамические блоки	11	08.08.2019 14:06
Создание динамического блока со скрытыми текстовыми атрибутами	IIIkunep	Динамические блоки	4	04.07.2016 13:52
Создание зависимого динамического блока	Начинающий архитектор	Динамические блоки	4	27.09.2014 06:02
Создание кнопки для динамического блока и привязка к чертижам	dmitry77	Программирование	10	07.05.2014 11:26
Создание блока с атрибутами	молодой человек	Программирование	5	15.11.2010 17:23

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