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

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]

den001 · 16.02.2007, 22:46

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

P.S. Не обижайся, я просто задолбался уже ковыряться с этим

Sleekka · 16.02.2007, 22:48

Да все ок. у тебя objektId в каком виде точно?

den001 · 16.02.2007, 23:08

В смысле, в каком виде? Получаю я его так:

Код:

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

  Dim Entry As AcadEntity, blk As AcadBlockReference
  ...
  attr = blk.GetAttributes()
  ID = attr(0).ObjectID

ID первого атрибута в блоке (остальные - по боку), тип - Long.

Sleekka · 16.02.2007, 23:32

Ща поналемерю просьба сильно не пинать:
Как я вижу, т.е. как приходится видеть всилу ламерских знаний.
Ты с ВБА получив ИД объекта, записываешь в 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

den001 · 17.02.2007, 00:10

Не-а. f2t как просила выбрать объект, так и просит.

Sleekka · 17.02.2007, 01:14

мда вижу =) лол, но после последующей подрезки даже Check не проходит.

Sleekka · 10.03.2007, 01:43

ну вот я вроде написал если конечно так можно назвать эту лажу, тока я хз как сделать чтобы результат вычислений не выводился командную строку
Документация:
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]

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]
Просмотров: 14103