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

maestro · 21.04.2006, 17:42

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

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

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

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

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

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

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

Кулик Алексей aka kpblc · 13.02.2007, 15:25

Ну ладно, а если просто получить ObjectID и запустить лисп с ним, выдаст результат или нет? Подчеркиваю - ObjectID надо делать не для блока, а для атрибута.
Если лисп сработал, то результат его выполения можно и в UserS1 засунуть, а из VBA прочитать значение.

Mercury · 13.02.2007, 16:29

Чего вы лиспы трогаете товарищи

Проблема в том что в рисунке возможно уже имеется вхождение этого блока..поэтому и происходит несогласованность.
Запусти команду purge, очисть все вхождения данного блока и удали его из рисунка..потом через дизайн центр вставь этот блок, и больше его не из кармана и из дизайн центра не вставляй..только копируй тот что первый раз вставил..зачем лиспы??

Кулик Алексей aka kpblc · 13.02.2007, 16:47

> 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 протестить качественно не получилось, на блоке с единственным атрибутом вроде срослось.

tokhot · Регистрация: 17.11.2004

Цитата:

Сообщение от 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

Кулик Алексей aka kpblc · 13.02.2007, 16:53

Понятно. Тема, как всегда, ушла в сторону от начальных задач

Mercury · 13.02.2007, 16:53

О чем я и говорил...

Кулик Алексей aka kpblc · 13.02.2007, 16:55

Ну ладно, народ, не бушуйте. Прочтите пост 5 - там den001 честно предупредил обо всем

Mercury · 13.02.2007, 16:56

Цитата:

Сообщение от Кулик Алексей aka kpblc

Понятно. Тема, как всегда, ушла в сторону от начальных задач

Задача была какая? Убрать матюки..так они исчезли..

tokhot · 13.02.2007, 17:09

Цитата:

Сообщение от Кулик Алексей aka kpblc

Понятно. Тема, как всегда, ушла в сторону от начальных задач

Алексей согласен с Вами !!!
Тема вильнула в сторону ВБА и ЛИСП :P на две стравницы...

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

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

А при копировании из одного файла в другой использовать DISIGNCENTER

den001 · 13.02.2007, 19:55

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

Только что, наконец, прочел, об чем был вопрос в теме, извлеченной мною из недр забвения

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

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

Крыс
По поводу моего вопроса.
К тебе обращены мои надежды!

Кулик Алексей aka kpblc · 14.02.2007, 09:19

Сегодня вроде в башке какое-никакое просветление наблюдается, так что может, и добьемся более интересных результатов

Итак, в лиспе я одну (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

Может, у тебя заработает?

den001 · 14.02.2007, 11:30

Крыс
Не-а, ни фига.
Что-то с Lisp'ом не то. Он вообще ACAD приводит в крайнее изумление. GetEntity перестает работать.
Не, тут не долго до санитаров

[sm1714]

den001 · 14.02.2007, 14:23

Крыс
Жизнь налаживается. Но 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

Работы по скрещиванию ужа с ежом (сиречь Lisp и VBA) прекращены в связи с ожесточенным сопротивлением обоих особей. [sm2100]

Sleekka · 16.02.2007, 00:48

Обсуждалось на форуме 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

den001 · 16.02.2007, 01:05

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

Sleekka · 16.02.2007, 01:32

У тебя установлен ET для автокада ошибка отсутсвующей фукции иногда из-за этого бывает, потому что ET - представляет еще собой и библиотеку пользовательских функций.

den001 · 16.02.2007, 02:03

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

Кстати, код в №12 рабочий, но он требует выбрать объект, а нужно, чтобы работал по ID.

Sleekka · 16.02.2007, 21:49

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

21.04.2006, 17:42
ПОле, вставленное в атрибут блока 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]
Просмотров: 14104