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

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > ПОле, вставленное в атрибут блока

ПОле, вставленное в атрибут блока

Ответ
Поиск в этой теме
Непрочитано 21.04.2006, 17:42 #1
ПОле, вставленное в атрибут блока
maestro
 
проектировщик
 
Украина
Регистрация: 08.05.2004
Сообщений: 1,123

Поля в атрибутах.

В теме
http://dwg.ru/forum/viewtopic.php?t=3488
говорилось о тонкостях программирование блока с атрибутами, в которые вставлено поле.

У меня другая проблема, но видимо, оно как-то перекликается.

Имеется блок. Динамический. Унутри- примитив. Меряем его длину и полем вставляем в атрибут. Суть проблемы- как только такой блок копируешь в карман и вставляешь заново, то вместо значений в полях там тольок кучи "плю-минусов", т.е. не считает. При попытке долезть до поля через атрибут ругается

The object referenced by the field is not a valid object.

В аттаче прилагаю ентот файл.

Господа- кто сталкивался и что делать?
[ATTACH]1145626930.rar[/ATTACH]
Просмотров: 14098
 
Непрочитано 21.04.2006, 17:45
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


ИМХО: неизлечимо. Поле привязывается к ID объекта, которое меняется при вставке из буфера. Поле надо переделывать.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 21.04.2006, 18:02
#3
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,345


у меня такая фигня творится с отметками что я делал. Иногда, случается при вставке из буфера обмена блока-отметки в файл где уже есть такой же блок. Лечу или удалением предыдущей версии блока или работаю в новом чистом файле. По другому ничего не придумал Притом что это не везде, а в некоторый файлах, что наталкивает на мысль, что что-то за это отвечает, но не в блоке проблема
asys вне форума  
 
Непрочитано 21.04.2006, 18:09
#4
Startrek

AutoCAD/AutoLISP
 
Регистрация: 27.08.2003
Seattle/USA
Сообщений: 1,133


в 2007-М можно привесить в атрибуту переменную лиспа ( вмест объекта) - может сработать если лиспом ее менять, но с динамическим блоком , черт его знает?
__________________
Сквозь тернии к звездам.... и обратно :yes:
Startrek вне форума  
 
Непрочитано 10.02.2007, 13:19
#5
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Поднимем из глубин тему.
Вопрос, собственно, по программированию, но не начинать же новую.

Кто знает, как из атрибута программно вытащить формулу поля (на VBA)?
Помогите, очень пожалуйста
den001 вне форума  
 
Непрочитано 11.02.2007, 23:01
#6
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Нда... Все сходится к тому, что на VBA эту задачу не решить. Может, на Lisp'e есть решение? Господа программеры! Не дайте сойти с ума!
den001 вне форума  
 
Непрочитано 12.02.2007, 03:31
#7
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


возможно я не так понял..
но вот это - %<\AcVar CustomDP.Масштаб>%
или вот это - %<\AcVar ctab>%
случайно не есть та самая "формула поля"?
Димас вне форума  
 
Непрочитано 12.02.2007, 11:50
#8
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Цитата:
возможно я не так понял..
но вот это - %<\AcVar CustomDP.Масштаб>%
или вот это - %<\AcVar ctab>%
случайно не есть та самая "формула поля"?
Да да она самая, тока теперь нужно достать ее програмно из атрибута вхождения блока, на лиспе или VBA.
Sleekka вне форума  
 
Непрочитано 12.02.2007, 11:57
#9
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


"Формулу" поля можно попробовать получить через .FieldCode. А значение - через .TextString (ЯТД).
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.02.2007, 12:04
#10
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Так в том то и дело, что у атрибута почему-то НЕТ свойства .FieldCode!

Собственно, если это невозможно на VBA, то остается один путь: каким-то манером передать из VBA в Lisp атрибут, как объект, или передать ID объекта, а обратно получить формулу поля (назовем это так). Возможно ли такое решение? C Lisp'ом я, мягко говоря, не знаком.
den001 вне форума  
 
Непрочитано 12.02.2007, 12:43
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Хм... Действительно. Есть только FieldLength, которая поможет как мертвому припарки.
Ну не хочет кад по-плохому, по-хорошему будет еще хуже
Без проверок, все на уровне идеи:
Код:
[Выделить все]
(defun _kpblc-block-get-field-codes (/ ent res)
  (if (and (setq ent (car (entsel "\nÓêàæèòå íà áëîê <Îòìåíà> : ")))
           (= (cdr (assoc 0 (entget ent))) "INSERT")
           (= (cdr (assoc 66 (entget ent))) 1)
           ) ;_ end of and
    (progn
      (setq res
             (mapcar
               '(lambda (x)
                  (cdr
                    (assoc
                      2
                      (entget
                        (cdr
                          (assoc
                            360
                            (entget
                              (cdr
                                (assoc
                                  360
                                  (entget
                                    (cdr
                                      (assoc 360 (entget (vlax-vla-object->ename x)))
                                      ) ;_ end of cdr
                                    ) ;_ end of entget
                                  ) ;_ end of assoc
                                ) ;_ end of cdr
                              ) ;_ end of entget
                            ) ;_ end of assoc
                          ) ;_ end of cdr
                        ) ;_ end of entget
                      ) ;_ end of assoc
                    ) ;_ end of cdr
                  ) ;_ end of lambda
               (vlax-safearray->list
                 (vlax-variant-value (vla-getattributes (vlax-ename->vla-object ent)))
                 ) ;_ end of vlax-safearray->list
               ) ;_ end of mapcar
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun
Предупреждаю сразу - не отслеживается наличие "не-полей" в качестве атрибутов. Это надо обрабатывать отдельно, а я сейчас не могу - работы многовато
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.02.2007, 21:29
#12
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Спасибо за помощь, однако код что-то не то выдает

На Lisp'e добрые люди задачу решили, теперь бьюсь головой об стену, как это в VBA запихать? Как передать в Lisp, ну допустим ID атрибута, а обратно получить код поля?

Вот код, который получает код поля (в данном случае - ссылку на другой текстовый объект, из-за чего, собственно, и весь сыр-бор), потом запрашивает МТекст, в который это поле вставляет
Код:
[Выделить все]
(defun C:FAV2 (/ att field_code field_list field_mask head objid tail txt)
  (vl-load-com)
  (if
    (setq att (car (nentsel "\nВыбери атрибут >> ")))
     (progn
       (setq field_list
	      (entget
		(cdr
		  (assoc
		    360
		    (entget
		      (cdr (assoc
			     360
			     (entget (cdr (assoc 360 (entget att))))
			   )
		      )
		    )
		  )
		)
	      )
       )
(setq txt (cdr (assoc 331 (entget (cdar	(cddddr	(member	'(100 . "AcDbField")
							field_list
						)
					)
				  )
			  )
	    )))
(setq field_mask (cdr (assoc 2 (entget (cdar	(cddddr	(member	'(100 . "AcDbField")
							field_list
						)
					)
				  )
			  )
	    )))
(setq objId (vla-get-objectid (vlax-ename->vla-object txt)))
(setq head (strcat "%<" (substr field_mask 1
	 (+ (vl-string-search "<" field_mask ) 2)) "_ObjId " (itoa objId)))
(setq tail (strcat (substr field_mask (1+ (vl-string-search ">" field_mask )))
		   " \\f " "\"%bl2\"" ">%"))
(setq field_code (strcat head tail))
(alert field_code)
(vla-put-textstring
  (vlax-ename->vla-object
    (car (entsel "\nВыбери MTEXT >>"))) field_code)
)
    )
)
(prompt "\n\t\t***\t  Type FAV2 to execute\t***")
(princ)
den001 вне форума  
 
Непрочитано 12.02.2007, 22:27
#13
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


2den001
Чы читал сотый элемент словаря AcDbField? на ВБА? в проге сказано что читается этот элемент, только поле там хранится не в нужном нам виде, а вдругом, потом получают ObjektID преобразовав VLA объект, о добавляют нужные скобки, и удаляют ненужные, вобщем скорее всего все ето хозяйство реализуемо на ВБА, КРЫС!!! ну разрули программу пожалуйста - очень надо!!!
Sleekka вне форума  
 
Непрочитано 12.02.2007, 23:01
#14
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Sleekka
Я ж говорил, не получилось у меня вообще словарь прочесть. Я пробовал .GetExtentionDictionary, и ни фига. Точнее, есть там объект "ACAD_FIELD", но попытки что-либо с ним сделать не увенчались успехом.
den001 вне форума  
 
Непрочитано 13.02.2007, 09:33
#15
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Так. Для лиспа у меня вроде как срослось:
Код:
[Выделить все]
(defun get-fld-code (/ blk att res)
  (vl-load-com)
  (if (and (setq blk (car (entsel "\nУказываем блок <Выход> : ")))
           (setq blk (vlax-ename->vla-object blk))
           (= (vla-get-objectname blk) "AcDbBlockReference")
           (< 0
              (vlax-safearray-get-u-bound
                (setq att (vlax-variant-value (vla-getattributes blk)))
                1
                ) ;_ end of vlax-safearray-get-u-bound
              ) ;_ end of >
           ) ;_ end of and
    (progn
      (vlax-for ent (vla-item (vla-get-blocks
                                (vla-get-activedocument (vlax-get-acad-object))
                                ) ;_ end of vla-get-blocks
                              (vla-get-name blk)
                              ) ;_ end of vla-item
        (if (= (vla-get-objectname ent) "AcDbAttributeDefinition")
          (setq att (append att (list ent)))
          ) ;_ end of if
        ) ;_ end of vlax-for
      (setq res
             (mapcar
               '(lambda (x)
                  (cdr
                    (assoc 2
                           (entget (cdr (assoc 360 (entget (cdr (assoc 360 x))))))
                           ) ;_ end of assoc
                    ) ;_ end of cdr
                  ) ;_ end of lambda
               (vl-remove-if-not
                 '(lambda (x) (assoc 3 x))
                 (mapcar
                   '(lambda (x)
                      (entget
                        (cdr (assoc 360 (entget (vlax-vla-object->ename x))))
                        ) ;_ end of entget
                      ) ;_ end of lambda
                   att
                   ) ;_ end of mapcar
                 ) ;_ end of vl-remove-if-not
               ) ;_ end of mapcar
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun
Вот только интересно, что в коде den001 делает 331 группа? По-моему, их там не особо есть, если атрибут - поле. Ну да ладно.
На VBA не получилось - через HasExtensionDictionary выполнить корректную проверку не удалось. Чего-то там совсем я запутался. В качестве начала что-то подобное:
Код:
[Выделить все]
Function GetFldCode()
Dim blk As AcadEntity, EntCounter  As AcadEntity
Dim BasePoint(2) As Double
Dim arAttr() As AcadEntity
On Error Resume Next
  ThisDrawing.Utility.GetEntity blk, BasePoint
  If Err <> 0 Or blk.ObjectName <> "AcDbBlockReference" Then
    MsgBox "Object selection error!", vbOKOnly + vbCritical + vbApplicationModal
    Exit Function
  End If
  For Each EntCounter In ThisDrawing.Blocks.Item(blk.Name)
    If EntCounter.ObjectName = "AcDbAttributeDefinition" And _
        EntCounter.HasExtensionDictionary And _
        EntCounter.GetExtensionDictionary(0).Name = "ACAD_FIELD" Then
      ReDim Preserve arAttr(UBound(arAttr) + 1)
      Set arAttr(UBound(arAttr)) = EntCounter
    End If
  Next EntCounter
End Function
Только почему-то в ADT 2005 корректно не срабатывало - засовывало все полностью. Скорее всего, проблема была именно в строке
Код:
[Выделить все]
EntCounter.GetExtensionDictionary(0).Name = "ACAD_FIELD"
Ведь GetExtrnsionDictionary не только возвращает указатель на словарь, но и создает его В общем, черт-те что...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 12:31
#16
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Спасибо.

А с GetExtensionDictionary я тоже долго возился, потом плюнул. Решил сойти с ума как-нибудь в другой раз

Как бы теперь Lisp и VBA увязать, вот вопрос? У меня есть ID атрибута (можно добыть ID блока, если надо), с каким бубном поскакать, чтобы он в код поля превратился? Меня пока не осенило...
den001 вне форума  
 
Непрочитано 13.02.2007, 12:52
#17
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Дык ента...
Если лиспом, то можно использовать нечто наподобие:
Код:
[Выделить все]
(strcat "%<\\|AcObjProp Object(%<\\_ObjID " (vla-get-ObjectID (vlax-ename->vla-object(car (entsel)))) "%>).И_ЗДЕСЬ_СВОЙСТВО")
Свойство - по аналогии с
Код:
[Выделить все]
XScaleFactor \\f \"%.30q0\">%"
Думаю, что на VBA будет нечто типа:
Код:
[Выделить все]
"%<\AcObjProp Object(%<\_ObjId " & _
    obj.ObjectID & ">%).XScaleFactor \f " & Chr(34) & _
    "%.30q0" & Chr(34) & ">%"
Я не проверял ни один вариант, ни другой, все на уровне предположений.
P.S. На форуме как-то вроде были решения по этому вопросу.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 13:35
#18
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Да я не об этом. Про это я в курсе.

Как из VBA вызвать Lisp-фунцкцию, которая по заданному ID атрибута вернет его значение в виде кода поля, с которым в VBA можно было бы дальше работать. Проще говоря, ищется замена отсутствующему в VBA свойству FieldCode для атрибутов.
Или я уже торможу? По-моему, еще нет...
den001 вне форума  
 
Непрочитано 13.02.2007, 14:40
#19
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Я сейчас торможу по-черному, поэтому не обижайся, ок?
ThsDrawing.SendCommand "(lisp-function parameters)"
ИМХО так вызывать функцию. А какие параметры ей передавать - ну это уж от нее и будет зависеть.
Нечто наподобие такого, наверное?
LISP:
Код:
[Выделить все]
(defun blk-att-field-code (att-id / att_obj res)
  (vl-catch-all-apply
    (function
      (lambda ()
        (setq att_obj (vla-objectidtoobject
                        (vla-get-activedocument (vlax-get-acad-object))
                        att-id
                        ) ;_ end of vla-ObjectIDToObject
              res     (cdr (assoc
                             2
                             (entget
                               (cdr
                                 (assoc
                                   360
                                   (entget
                                     (cdr
                                       (assoc
                                         360
                                         (entget
                                           (cdr
                                             (assoc
                                               360
                                               (entget (vlax-vla-object->ename att_obj))
                                               ) ;_ end of assoc
                                             ) ;_ end of cdr
                                           ) ;_ end of entget
                                         ) ;_ end of assoc
                                       ) ;_ end of cdr
                                     ) ;_ end of entget
                                   ) ;_ end of assoc
                                 ) ;_ end of cdr
                               ) ;_ end of entget
                             ) ;_ end of assoc
                           ) ;_ end of cdr
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (if (not res)
    ""
    res
    ) ;_ end of if
  ) ;_ end of defun
VBA:
Код:
[Выделить все]
ThisDrawing.SendCommand "(blk-att-field-code " & CStr(obj.ObjectID) & ")"
Оно?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 15:15
#20
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Не-а

Что-то и Lisp не то выдает, и это, SendCommand же ничего не возвращает... [sm1402]
den001 вне форума  
 
Непрочитано 13.02.2007, 15:25
#21
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Ну ладно, а если просто получить ObjectID и запустить лисп с ним, выдаст результат или нет? Подчеркиваю - ObjectID надо делать не для блока, а для атрибута.
Если лисп сработал, то результат его выполения можно и в UserS1 засунуть, а из VBA прочитать значение.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 16:29
#22
Mercury

Инженер-конструктор
 
Регистрация: 09.04.2006
г. Запорожье Украина
Сообщений: 368
<phrase 1=


Чего вы лиспы трогаете товарищи
Проблема в том что в рисунке возможно уже имеется вхождение этого блока..поэтому и происходит несогласованность.
Запусти команду purge, очисть все вхождения данного блока и удали его из рисунка..потом через дизайн центр вставь этот блок, и больше его не из кармана и из дизайн центра не вставляй..только копируй тот что первый раз вставил..зачем лиспы??
Mercury вне форума  
 
Непрочитано 13.02.2007, 16:47
#23
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


> Mercury : Я судорожно пытаюсь понять, про что твоя реплика.
Цитата:
Чего вы лиспы трогаете товарищи
Проблема в том что в рисунке возможно уже имеется вхождение этого блока..поэтому и происходит несогласованность.
Запусти команду purge, очисть все вхождения данного блока и удали его из рисунка..потом через дизайн центр вставь этот блок, и больше его не из кармана и из дизайн центра не вставляй..только копируй тот что первый раз вставил..зачем лиспы??
При чем тут это? Блок гарантированно вставлен (мало того что определен, так еще и вставлен), внутри него есть атрибут-поле, надо с этого атрибута получить FieldCode. Ты сможешь этого добиться без программирования? Я, честно говоря, не думаю.
В общем, чтоб было чего тестить:
lisp:
Код:
[Выделить все]
(defun blk-att-field-code (att-id / att_obj res)
  (vl-catch-all-apply
    (function
      (lambda ()
        (setq att_obj (vla-objectidtoobject
                        (vla-get-activedocument (vlax-get-acad-object))
                        att-id
                        ) ;_ end of vla-ObjectIDToObject
              res     (cdr (assoc
                             2
                             (entget
                               (cdr
                                 (assoc
                                   360
                                   (entget
                                     (cdr
                                       (assoc
                                         360
                                         (entget
                                           (cdr
                                             (assoc
                                               360
                                               (entget (vlax-vla-object->ename att_obj))
                                               ) ;_ end of assoc
                                             ) ;_ end of cdr
                                           ) ;_ end of entget
                                         ) ;_ end of assoc
                                       ) ;_ end of cdr
                                     ) ;_ end of entget
                                   ) ;_ end of assoc
                                 ) ;_ end of cdr
                               ) ;_ end of entget
                             ) ;_ end of assoc
                           ) ;_ end of cdr
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (setvar "users1"
          (if (not res)
            ""
            res
            ) ;_ end of if
          ) ;_ end of setvar
  ) ;_ end of defun
VBA:
Код:
[Выделить все]
Function GetFldCode() As String()
Dim blk As AcadEntity, EntCounter  As AcadEntity
Dim BasePoint(2) As Double, lCounter As Long
Dim arAttr() As AcadEntity, arRes() As String
Dim SysVarUserS1 As String
On Error Resume Next
  ThisDrawing.Utility.GetEntity blk, BasePoint
  If Err <> 0 Or blk.ObjectName <> "AcDbBlockReference" Then
    MsgBox "Object selection error!", vbOKOnly + vbCritical + vbApplicationModal
    Exit Function
  End If
  For Each EntCounter In ThisDrawing.Blocks.Item(blk.Name)
    If EntCounter.ObjectName = "AcDbAttributeDefinition" And _
        EntCounter.HasExtensionDictionary And _
        EntCounter.GetExtensionDictionary(0).Name = "ACAD_FIELD" Then
      ReDim Preserve arAttr(UBound(arAttr) + 1)
      Set arAttr(UBound(arAttr)) = EntCounter
    End If
  Next EntCounter
  SysVarUserS1 = ThisDrawing.GetVariable("users1")
  ReDim arRes(UBound(arAttr))
  For lCounter = 0 To UBound(arAttr)
    ThisDrawing.SendCommand "(blk-att-field-code " & CStr(arAttr(lCounter).ObjectID) & ")"
    arRes(lCounter) = ThisDrawing.GetVariable("users1")
  Next lCounter
  GetFldCode = arRes
End Function
Предупреждаю - у меня на ADT 2005 протестить качественно не получилось, на блоке с единственным атрибутом вроде срослось.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 16:48 Re: ПОле, вставленное в атрибут блока
#24
tokhot

Проектирование
 
Регистрация: 17.11.2004
г. Москва
Сообщений: 328


Цитата:
Сообщение от maestro
Поля в атрибутах.

В теме
http://dwg.ru/forum/viewtopic.php?t=3488
говорилось о тонкостях программирование блока с атрибутами, в которые вставлено поле.

У меня другая проблема, но видимо, оно как-то перекликается.

Имеется блок. Динамический. Унутри- примитив. Меряем его длину и полем вставляем в атрибут. Суть проблемы- как только такой блок копируешь в карман и вставляешь заново, то вместо значений в полях там тольок кучи "плю-минусов", т.е. не считает. При попытке долезть до поля через атрибут ругается

The object referenced by the field is not a valid object.

В аттаче прилагаю ентот файл.

Господа- кто сталкивался и что делать?
[ATTACH]1145626930.rar[/ATTACH]
Пользуйся

_copy ,а не _copyclip и _copybase
tokhot вне форума  
 
Непрочитано 13.02.2007, 16:53
#25
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Понятно. Тема, как всегда, ушла в сторону от начальных задач
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 16:53
#26
Mercury

Инженер-конструктор
 
Регистрация: 09.04.2006
г. Запорожье Украина
Сообщений: 368
<phrase 1=


О чем я и говорил...
Mercury вне форума  
 
Непрочитано 13.02.2007, 16:55
#27
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Ну ладно, народ, не бушуйте. Прочтите пост 5 - там den001 честно предупредил обо всем
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2007, 16:56
#28
Mercury

Инженер-конструктор
 
Регистрация: 09.04.2006
г. Запорожье Украина
Сообщений: 368
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc
Понятно. Тема, как всегда, ушла в сторону от начальных задач
Задача была какая? Убрать матюки..так они исчезли..
Mercury вне форума  
 
Непрочитано 13.02.2007, 17:09
#29
tokhot

Проектирование
 
Регистрация: 17.11.2004
г. Москва
Сообщений: 328


Цитата:
Сообщение от Кулик Алексей aka kpblc
Понятно. Тема, как всегда, ушла в сторону от начальных задач
Алексей согласен с Вами !!!
Тема вильнула в сторону ВБА и ЛИСП :P на две стравницы...

Но у maestro есть вполне простой вопрос:
в блоке при копировании появляются "плюсо-минусы". Что делать?

мой ответ очч прост использовать Copy Selection, а не Copy и Copy Base Point.

А при копировании из одного файла в другой использовать DISIGNCENTER
tokhot вне форума  
 
Непрочитано 13.02.2007, 19:55
#30
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Mercury, tokhot
Об чем шум-то? Тема с апреля неживая была

Крыс
С users1 спасибо, наверное, едиственный путь. Дело осталось за Lisp'ом. Ты, наверное, уже понял, что я в нем, как младенец Твой код выдает "%<\\_FldIdx 0>%", в то время как ожидается "%<\AcObjProp Object(%<\_ObjId 2130304384>%).TextString \f "%tc3">%", или что-нибудь в этом роде. Кстати, код в посте №12, выдавал правильный результат (это с Fatty с autocad.ru написал), можно его как-нибудь переделать, чтобы он результат записывал в users1?

P.S. Да, и еще я проверяю конкретное значение атрибута (AttributeReference, а не AttributeDefinition)
Вот в таком виде:
Код:
[Выделить все]
Function GetFldCode()
  Dim Entry As AcadEntity, blk As AcadBlockReference
  ThisDrawing.Utility.GetEntity Entry, pnt
  Set blk = Entry
  attr = blk.GetAttributes()
  ID = attr(0).ObjectID
  ThisDrawing.SendCommand "(blk-att-field-code " & CStr(ID) & ") "
  GetFldCode = ThisDrawing.GetVariable("users1")
End Function
den001 вне форума  
 
Непрочитано 14.02.2007, 00:18
#31
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Только что, наконец, прочел, об чем был вопрос в теме, извлеченной мною из недр забвения И решение готовое за №24 от torhot'a. Остается только надеяться, что maestro еще заглянет сюда как-нибудь (если для него эта проблема еще актуальна).

P.S. А я, кстати, и не знал (или забыл крепко), что при копировании через буфер поля слетают. Все время копировал их командой _copy.

Крыс
По поводу моего вопроса.
К тебе обращены мои надежды!
den001 вне форума  
 
Непрочитано 14.02.2007, 09:19
#32
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,431


Сегодня вроде в башке какое-никакое просветление наблюдается, так что может, и добьемся более интересных результатов
Итак, в лиспе я одну (entget) пропустил, вариант
Код:
[Выделить все]
(defun blk-att-field-code (att-id / att_obj res)
  (vl-catch-all-apply
    (function
      (lambda ()
        (setq att_obj (vla-objectidtoobject
                        (vla-get-activedocument (vlax-get-acad-object))
                        att-id
                        ) ;_ end of vla-ObjectIDToObject
              res     (cdr
                        (assoc
                          2
                          (entget
                            (cdr
                              (assoc 360
                                     (entget
                                       (cdr
                                         (assoc
                                           360
                                           (entget
                                             (cdr
                                               (assoc
                                                 360
                                                 (entget
                                                   (cdr
                                                     (assoc
                                                       360
                                                       (entget
                                                         (vlax-vla-object->ename att_obj)
                                                         ) ;_ end of entget
                                                       ) ;_ end of assoc
                                                     ) ;_ end of cdr
                                                   ) ;_ end of entget
                                                 ) ;_ end of assoc
                                               ) ;_ end of cdr
                                             ) ;_ end of entget
                                           ) ;_ end of assoc
                                         ) ;_ end of cdr
                                       ) ;_ end of entget
                                     ) ;_ end of assoc
                              ) ;_ end of cdr
                            ) ;_ end of entget
                          ) ;_ end of assoc
                        ) ;_ end of cdr
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (setvar "users1"
          (if (not res)
            ""
            res
            ) ;_ end of if
          ) ;_ end of setvar
  ) ;_ end of defun
возвращает нормальное значение кода поля. Теперь насчет VBA:
Ну не дружу я с ним, хоть тресни! Блин, я раздолбаю системник! Какого ляда оно не срабатывает?
Код:
[Выделить все]
Function GetFldCode() As String()
Dim blk As AcadEntity, EntCounter  As AcadEntity
Dim BasePoint(2) As Double, lCounter As Long
Dim arAttr() As AcadEntity, arRes() As String
Dim SysVarUserS1 As String
On Error Resume Next
  ThisDrawing.Utility.GetEntity blk, BasePoint
  If Err <> 0 Or blk.ObjectName <> "AcDbBlockReference" Then
    MsgBox "Object selection error!", vbOKOnly + vbCritical + vbApplicationModal
    Exit Function
  End If
  For Each EntCounter In ThisDrawing.Blocks.Item(blk.Name)
    If EntCounter.ObjectName = "AcDbAttributeDefinition" And _
        EntCounter.HasExtensionDictionary Then 'And _
        'EntCounter.GetExtensionDictionary(0).Name = "ACAD_FIELD" Then
      ReDim Preserve arAttr(UBound(arAttr) + 1)
      Set arAttr(UBound(arAttr)) = EntCounter
    End If
  Next EntCounter
  SysVarUserS1 = ThisDrawing.GetVariable("users1")
  ReDim arRes(UBound(arAttr))
  For lCounter = 0 To UBound(arAttr)
    ThisDrawing.SendCommand "(blk-att-field-code " & CStr(arAttr(lCounter).ObjectID) & ")"
    arRes(lCounter) = ThisDrawing.GetVariable("users1")
  Next lCounter
  ThisDrawing.SetVariable "users1", SysVarUserS1
  GetFldCode = arRes
End Function

Sub Test()
Dim lCounter As Long, arRes() As String
Dim sMsg As String
  arRes = GetFldCode
  For lCounter = 0 To UBound(arRes)
    sMsg = sMsg & arRes(lCounter) & Chr(10)
  Next lCounter
  MsgBox sMsg
End Sub
Может, у тебя заработает?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.02.2007, 11:30
#33
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Не-а, ни фига.
Что-то с Lisp'ом не то. Он вообще ACAD приводит в крайнее изумление. GetEntity перестает работать.
Не, тут не долго до санитаров [sm1714]
den001 вне форума  
 
Непрочитано 14.02.2007, 14:23
#34
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Крыс
Жизнь налаживается. Но Lisp все равно выдает неправильный результат.
\\AcObjProp Object(%<\\_ObjIdx 0>%).TextString
В то время, как должно быть
%<\AcObjProp Object(%<\_ObjId 2059676856>%).TextString>%

Из VBA нужно передавать все-таки ID AttributeReference, a не AttributeDefinition из пространства блока.

Код, как и был в №30
Код:
[Выделить все]
Public Function GetFldCode()
  Dim Entry As AcadEntity, blk As AcadBlockReference
  ThisDrawing.Utility.GetEntity Entry, pnt
  Set blk = Entry
  attr = blk.GetAttributes()
  ID = attr(0).ObjectID
  ThisDrawing.SendCommand "(blk-att-field-code " & CStr(ID) & ") "
  GetFldCode = ThisDrawing.GetVariable("users1")
End Function
(по минимальной пока схеме, и только первый атрибут блока)
В Lisp'e, я так понял, дело за малым: в возвращаемой строке напрочь отсутствует упоминание об ID объекта и неправильный синтаксис.

"Я говорю - сойду с ума, она мне - погоди" В.Высоцкий

P.S. Может, эту тему пора уже в Программирование переместить?
den001 вне форума  
 
Непрочитано 15.02.2007, 22:59
#35
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Работы по скрещиванию ужа с ежом (сиречь Lisp и VBA) прекращены в связи с ожесточенным сопротивлением обоих особей. [sm2100]
den001 вне форума  
 
Непрочитано 16.02.2007, 00:48
#36
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Обсуждалось на форуме autodesk.com
http://discussion.autodesk.com/threa...sageID=5034943
вот код на лиспе и макрос на ВБА выложеный автаром:
Цитата:
;Start of AutoLISP code:

(defun GetFieldCode (handle / tmp fld fldCounter subFldTxt fldNo fldList)
(setq tmp (entget (handent handle))) ; get the entity
(princ "\n")
(setq fld
(entget
(cdr
(assoc
'360
(entget (cdr (assoc '360 (entget (cdr (assoc '360 tmp)))))
; get the field object
)
)
)
)
)

(setq fldtxt (cdr (assoc '2 fld))) ; get the field pattern string
(setq fldCounter 0)
(setq fldNo (cdr (assoc '90 fld))) ; number of fields
(setq fldList (vl-remove-if 'null (mapcar '(lambda (a) (if (= (car a) 360) a)) fld))) ; filter list of field entities
(while (< fldCounter fldNo) ; loop to the number of fields
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter)))
; part of the field string to be replaced
(setq subFldTxt
(cdr (assoc '2 (entget (cdr (nth fldCounter fldList)))))
) ; get the actual field string for each sub field
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt))
; and replace it in the text string
(setq fldCounter (1+ fldCounter))
)

(setvar "USERS1" fldtxt) ; save the output field code to USERS1 system variable
(princ)
)

(defun C:TFC() ; Test GetFieldCode function
(setq hnd (cdr (assoc '5 (entget (car (nentsel)))))) ; gettign the entity handle
(GetFieldCode hnd)
(princ fldtxt)
(princ)
)

;Endt of AutoLISP code:
Вот макрос на ВБА от него же.
Цитата:
;Start of VBA macros

Private Function GetFieldCode(ByVal objHandle As String) As String
On Error GoTo ErrorHandler
Dim cmd As String
ThisDrawing.SetVariable "CMDECHO", 0
cmd = "(GetFieldCode """ & objHandle & """) "
ThisDrawing.SendCommand cmd
GetFieldCode = ThisDrawing.GetVariable("USERS1")
ErrorHandler:
If Err Then
Debug.Print "GetFieldCode: " & Err.Description
GetFieldCode = ""
Err.Clear
End If
ThisDrawing.SetVariable "CMDECHO", 1
End Function

Sub testGetFieldCode()
On Error GoTo ErrorHandler
Dim Object As AcadObject
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
Debug.Print Object.TextString
Debug.Print GetFieldCode(Object.handle)
ErrorHandler:
If Err Then
Debug.Print Err.Description
End If
End Sub

;End of VBA macros
Улучшенный код от другого участника форума lisp:
Цитата:
;;;Code starts here

;; GetFieldCode Fuction
;; By: Hossein Najmi
;; Date: Jul 2005
;; last updated: Dec 2005
;; Changed to retrive all children field codes

(defun C:f2t
(/ ent fldObj)
;; get the entity
(setq ent (entget (car (nentsel))))
(princ "\n")
;; get the parent field object
(if (/= (assoc '360 ent) nil)
(progn
(setq fldObj
(entget
(cdr
(assoc
'360
(entget (cdr (assoc '360
(entget (cdr (assoc '360 ent)))
)
)
)
)
)
)

)
;; run GetFieldCode function to iterate through all field children
;; and retrieve the field code using recursion technique
(setq fldtxt (GetFieldCode fldObj))

(princ fldtxt)
)
)
(princ)
)

;; function to get the field code from a FIELD object and
;; from all the children it may have
(defun GetFieldCode (fldObj / tmp fldtxt
fldCounter subFldTxt fldNo subFldObj
fldList
)
;; get the field pattern string
(setq fldtxt (cdr (assoc '2 fldObj)))

(setq fldCounter 0)
;; number of fields
(setq fldNo (cdr (assoc '90 fldObj)))
;; filter the list of field entities
(setq fldList (vl-remove-if
'null
(mapcar '(lambda (a)
(if (= (car a) 360)
a
)
)
fldObj
)
)
)

;; loop to the number of fields
(while (< fldCounter fldNo)
;; part of the field string to be replaced
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter)))
(setq subFldObj (entget (cdr (nth fldCounter fldList))))
;; get the actual field string for each sub field
(setq subFldTxt (if (= 0 (cdr (assoc '90 subFldObj)))
(cdr (assoc '2 subFldObj))
(GetFieldCode subFldObj)
)
)

;; get the ObjectId if there is any refernce to an Object
(if (/= (assoc '331 (entget (cdr (nth fldCounter fldList))))
nil
)
(progn
(setq subFldOid
(strcat
"ObjId "
(itoa
(vla-get-ObjectID
(vlax-ename->vla-object
(cdr
(assoc
'331
(entget (cdr (nth fldCounter fldList)))
)
)
)
)
)
)
)
;; insert the ObjectId in the code
(setq
subFldTxt (vl-string-subst subFldOid "ObjIdx 0" subFldTxt)
)
)
)
;; replace subfield code in the text string
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt))
(setq fldCounter (1+ fldCounter))
)
(setq output fldtxt)
)

;;; Code ends here
Sleekka вне форума  
 
Непрочитано 16.02.2007, 01:05
#37
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Первый лисп выдает то же, что и в №34, второй - ошибку (ошибка из-за неправильного имени функции, надо макрос переписывать, а я не врублюсь никак, что он хочет, надо Lisp смотреть)
den001 вне форума  
 
Непрочитано 16.02.2007, 01:32
#38
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


У тебя установлен ET для автокада ошибка отсутсвующей фукции иногда из-за этого бывает, потому что ET - представляет еще собой и библиотеку пользовательских функций.
Sleekka вне форума  
 
Непрочитано 16.02.2007, 02:03
#39
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Да причем здесь ET?? Он функцию, прописанную в лиспе не видит почему-то. В первом случае это GetFieldCode, во втором f2t. Но в ответ на f2t он говорит, что ничего такого не знает, и вообще он здесь не при чем.

Кстати, код в №12 рабочий, но он требует выбрать объект, а нужно, чтобы работал по ID.
den001 вне форума  
 
Непрочитано 16.02.2007, 21:49
#40
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


den001
Успокойся пожалуйста, на тебя никто не давит, просто не понятно что у тебя не работает? 1 лисп в моем посте выдает мутату какую то но зато второй выдает нормальный результат. %<\AcObjProp Object(%<\_ObjId 2130191104>%).TextString>%
вот такой например, теперь осталось, только сделать следующее передать данные на ВБА и сделать так чтобы ВБА запустило лисп как я понимаю, ето не проблема, я только не вкурсе как ВБА будет ожидать результата, можно например реактор соорудить на появление в Переменной user1 какого то результата, потому что она пока 0.
Второй лисп не использует глобальных переменных автокада выводит данные в лисповские переменные, возможно это вызывает у тебя трудности, пиши чем смогу помогу.
Sleekka вне форума  
 
Непрочитано 16.02.2007, 22:46
#41
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Блин, действительно, работает. Но он предлагает выбрать объект, такое решение уже есть в №12. А нужно в него через VBA ID атрибута передать, а ответ записать в users1. Вот эту задачу если решим, то остальное - дело техники. Но задача оная решается только на Lisp'e, это, увы, не ко мне. [sm2100]
В общем, нужен код на Lisp'e, который по заданному ID атрибута записывает код поля в users1

P.S. Не обижайся, я просто задолбался уже ковыряться с этим
den001 вне форума  
 
Непрочитано 16.02.2007, 22:48
#42
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Да все ок. у тебя objektId в каком виде точно?
Sleekka вне форума  
 
Непрочитано 16.02.2007, 23:08
#43
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


В смысле, в каком виде? Получаю я его так:
Код:
[Выделить все]
  Dim Entry As AcadEntity, blk As AcadBlockReference
  ...
  attr = blk.GetAttributes()
  ID = attr(0).ObjectID
ID первого атрибута в блоке (остальные - по боку), тип - Long.
den001 вне форума  
 
Непрочитано 16.02.2007, 23:32
#44
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Ща поналемерю просьба сильно не пинать:
Как я вижу, т.е. как приходится видеть всилу ламерских знаний.
Ты с ВБА получив ИД объекта, записываешь в Users2, лисп читает ету цифирь, делает че ему и положено, и записывает field code в USERS1, ты пишешь реактор на значение отличное от nil, в переменной USERS1 на вба, и считываешь данные из нее.
Я полный ламер, понятия не имею как пользоваться средой, Visual lisp, но по моему ламерскому мнению вот ето должно работать, в противном случае придется ждать ОТЦОВ, чтобы подсобили:
Цитата:
;;;Code starts here

;; GetFieldCode Fuction
;; By: Hossein Najmi
;; Date: Jul 2005
;; last updated: Dec 2005
;; Changed to retrive all children field codes

(defun C:f2t
(/ ent fldObj ObIDden001)
;;Sleekka>>> Read User2 to take data
(setq ObIDden001 (getvar "USERS2"))
;; get the entity
(setq ent (entget (car (nentsel))))
(princ "\n")
;; get the parent field object
(if (/= (assoc '360 ent) nil)
(progn
(setq fldObj
(entget
(cdr
(assoc
'360
(entget (cdr (assoc '360
(entget (cdr (assoc '360 ent)))
)
)
)
)
)
)

)
;; run GetFieldCode function to iterate through all field children
;; and retrieve the field code using recursion technique
(setq fldtxt (GetFieldCode fldObj))

(princ fldtxt)
)
)
(princ)
)

;; function to get the field code from a FIELD object and
;; from all the children it may have
(defun GetFieldCode (fldObj ObIDden001 / tmp fldtxt
fldCounter subFldTxt fldNo subFldObj
fldList
)
;; get the field pattern string
(setq fldtxt (cdr (assoc '2 fldObj)))

(setq fldCounter 0)
;; number of fields
(setq fldNo (cdr (assoc '90 fldObj)))
;; filter the 00000 field entities
(setq fldList (vl-remove-if
'null
(mapcar '(lambda (a)
(if (= (car a) 360)
a
)
)
fldObj
)
)
)

;; loop to the number of fields
(while (< fldCounter fldNo)
;; part of the field string to be replaced
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter)))
(setq subFldObj (entget (cdr (nth fldCounter fldList))))
;; get the actual field string for each sub field
(setq subFldTxt (if (= 0 (cdr (assoc '90 subFldObj)))
(cdr (assoc '2 subFldObj))
(GetFieldCode subFldObj)
)
)

;; get the ObjectId if there is any refernce to an Object
(if (/= (assoc '331 (entget (cdr (nth fldCounter fldList))))
nil
)
(progn
(setq subFldOid
(strcat
"ObjId "
(itoa ObIDden001
)
)
)
;; insert the ObjectId in the code
(setq
subFldTxt (vl-string-subst subFldOid "ObjIdx 0" subFldTxt)
)
)
)
;; replace subfield code in the text string
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt))
(setq fldCounter (1+ fldCounter))
)
(setq output fldtxt)
(setvar "USERS1" fldtxt)
)

;;; Code ends here
Sleekka вне форума  
 
Непрочитано 17.02.2007, 00:10
#45
den001

Инженер по автоматизации (строительство)
 
Регистрация: 05.05.2006
Люберцы
Сообщений: 241


Не-а. f2t как просила выбрать объект, так и просит.
den001 вне форума  
 
Непрочитано 17.02.2007, 01:14
#46
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


мда вижу =) лол, но после последующей подрезки даже Check не проходит.
Sleekka вне форума  
 
Непрочитано 10.03.2007, 01:43
#47
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


ну вот я вроде написал если конечно так можно назвать эту лажу, тока я хз как сделать чтобы результат вычислений не выводился командную строку
Документация:
1) лисп вызывается без параметров из командной строки вводом "f2t"
2) считывает значение из пользовательской переменной users1
3) результат вычислений заностит в пользовательскую переменную users2

Код:
[Выделить все]
;;;Code starts here 

;; GetFieldCode Fuction 
;; By: Hossein Najmi 
;; Date: Jul 2005 
;; last updated: Dec 2005 
;; Changed to retrive all children field codes 
;

(defun C:f2t 
(/ ent fldObj)
(setvar "users2" "666")
(begin_activex)
(setq en1 (vlax-vla-object->ename (vla-ObjectIDtoObject active_doc (getvar "USERS1")
				    )
	    )
  )
;; get the entity 
(setq ent (entget en1)) 
(princ "\n")  
;; get the parent field object 
(if (/= (assoc '360 ent) nil) 
(progn 
(setq fldObj 
(entget 
(cdr 
(assoc 
'360 
(entget (cdr (assoc '360 
(entget (cdr (assoc '360 ent))) 
) 
) 
) 
) 
) 
) 
)
;; run GetFieldCode function to iterate through all field children 
;; and retrieve the field code using recursion technique 
(setq fldtxt (GetFieldCode fldObj)) 

) 
) 
) 

;; function to get the field code from a FIELD object and 
;; from all the children it may have 
(defun GetFieldCode (fldObj / tmp fldtxt 
fldCounter subFldTxt fldNo subFldObj 
fldList 
) 
;; get the field pattern string 
(setq fldtxt (cdr (assoc '2 fldObj))) 

(setq fldCounter 0) 
;; number of fields 
(setq fldNo (cdr (assoc '90 fldObj))) 
;; filter the 00000 field entities 
(setq fldList (vl-remove-if 
'null 
(mapcar '(lambda (a) 
(if (= (car a) 360) 
a 
) 
) 
fldObj 
) 
) 
) 

;; loop to the number of fields 
(while (< fldCounter fldNo) 
;; part of the field string to be replaced 
(setq tmp (strcat "\\_FldIdx " (itoa fldCounter))) 
(setq subFldObj (entget (cdr (nth fldCounter fldList)))) 
;; get the actual field string for each sub field 
(setq subFldTxt (if (= 0 (cdr (assoc '90 subFldObj))) 
(cdr (assoc '2 subFldObj)) 
(GetFieldCode subFldObj) 
) 
) 

;; get the ObjectId if there is any refernce to an Object 
(if (/= (assoc '331 (entget (cdr (nth fldCounter fldList)))) 
nil 
) 
(progn 
(setq subFldOid 
(strcat 
"ObjId " 
(itoa 
(vla-get-ObjectID 
(vlax-ename->vla-object 
(cdr 
(assoc 
'331 
(entget (cdr (nth fldCounter fldList))) 
) 
) 
) 
) 
) 
) 
) 
;; insert the ObjectId in the code 
(setq 
subFldTxt (vl-string-subst subFldOid "ObjIdx 0" subFldTxt) 
) 
) 
) 
;; replace subfield code in the text string 
(setq fldtxt (vl-string-subst subFldTxt tmp fldtxt)) 
(setq fldCounter (1+ fldCounter)) 
) 
(setq output fldtxt)
(setvar "USERS2" output)
)

(defun begin_activex ( / )
(vl-load-com)
(setq acad_app (vlax-get-acad-object))
(setq active_doc (vla-get-activedocument acad_app))
(setq model_space (vla-get-modelspace active_doc))
(setq paper_space (vla-get-paperspace active_doc))
)


; code ends here
И еще креплю файл для тестирования
[ATTACH]1173480667.dwg[/ATTACH]
Sleekka вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > ПОле, вставленное в атрибут блока

Опции темы Поиск в этой теме
Поиск в этой теме:

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