Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Copy FieldCode from attrib to attrib

8 views
Skip to first unread message

Marc'Antonio Alessi

unread,
Feb 14, 2005, 12:34:11 PM2/14/05
to
I need to copy the fieldcode from attrib to attrib
(or, better, from ATTRIB,ATTDEF,TEXT,MTEXT to ATTRIB,ATTDEF,TEXT,MTEXT)

I tried to modify my COPY_STRING but this do not work
(note: the ATTRIB do not have the FieldCode method).

I have a block with several attribs:

Item NO.
Item Descr.
Item Q.ty
...
Item NO. A
Item NO. B
Item NO. C
...

I need to modify only the main Item NO. and update all the
others Item NO. A,B,C...
(no reactors)


Any hint?

[code]

(defun C:ALE_COPY_STRING ( / EntNam EntDat ValStr EntLs1 EntLs2 PrmStr)
(setq PrmStr "\nSelect origin String: ")
(while (setq EntNam (car (setq EntLs1 (nentsel PrmStr))))
(if
(and
EntNam
(wcmatch
(DXF 0 (setq EntDat (entget EntNam))) "ATTRIB,ATTDEF,TEXT,MTEXT"
)
(setq ValStr (DXF 1 EntDat))
)
(progn
(setq PrmStr "\nSelect origin String [Return to quit]: ")
(initget "Multiple")
(if
(= "Multiple"
(setq EntLs2
(nentsel "\nSelect the target String [Multiple]: ")
)
)
(while
(setq EntLs2
(nentsel "\nSelect the target String [Return to quit]: ")
)
(ALE_UPD_STRING EntLs1 EntLs2 ValStr)
)
(ALE_UPD_STRING EntLs1 EntLs2 ValStr)
)
);progn
(princ "\nNo String selected! Try again. ")
)
)
(princ)
)
;
(defun ALE_UPD_STRING (EntLs1 EntLs2 ValStr / EntNm2 EntDt1 EntDt2 EntDt3)
(cond
( (and
(setq EntNm2 (car EntLs2))
(wcmatch
(DXF 0 (setq EntDt2 (entget EntNm2))) "ATTRIB,ATTDEF,TEXT,MTEXT"
)
)
(cond
( (= (length EntLs2) 4)
(setq EntNm2 (last (last EntLs2)))
(if (= "DIMENSION" (DXF 0 (setq EntDt3 (entget EntNm2))))
(if
(and
(= (length EntLs1) 4)
(= "DIMENSION"
(DXF 0 (setq EntDt1 (entget (last (last EntLs1)))))
)
)
(setq EntDt2 EntDt3 ValStr (DXF 1 EntDt1))
(setq EntDt2 EntDt3)
)
)
)
)
(or EntDt1 (setq EntDt1 (entget (car EntLs1))))
; this do not work
(if (= "{ACAD_XDICTIONARY" (DXF 102 EntDt1))
(setq EntDt2
(append
EntDt2
(list
'(102 . "{ACAD_XDICTIONARY") (assoc 360 EntDt1) '(102 . "}")
)
)
)
)
; end
(if (entmod (subst (cons 1 ValStr) (assoc 1 EntDt2) EntDt2))
(entupd EntNm2)
(alert "ENTMOD error.")
)
)
( T (princ "\nNo String selected! Restart. ") )
)
)
[code]


--

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")

--

Luis Esquivel

unread,
Feb 14, 2005, 1:10:09 PM2/14/05
to
Can you post also one of your blocks....

--

http://www.draftteam.com


Luis Esquivel

unread,
Feb 16, 2005, 10:50:31 PM2/16/05
to
Marco,

I have been kind of busy and without to much time to make some tests right now to your code.

I will provide to you some of the field code I have that is not to much, but might help you.

This code portions is to change the color of a field object
The analysis to find out if is a field is kind of mickey mouse solution but is my earlier things with FIELD's, Jason Piercey wrote a function for this in particular

[code]
(C)2005 Jason Piercey
; function to determine if a field
; has been applied to an object.
; Arguments:
; [object] - vla-object
; return: vla-object, IAcadObject or nil
; Notes:
; First stab at doing anything with fields
; unsure if this function will cover all
; instances that are possible.
(defun field-p (object / result)
(if
(and
(= :vlax-true (vla-get-hasextensiondictionary object))
(setq
result
(vl-catch-all-apply
(function
(lambda ()
(vla-item
(vla-getextensiondictionary object)
"Acad_field")))))
(not (vl-catch-all-error-p result)) )

(vla-item result 0)
)
)
[/code]

[code]
;; case 1: contains parameter \\C
(if (and (wcmatch (getvar "acadver") "16*")
(vla-fieldcode obj)
(vl-string-search "%<" (vla-fieldcode obj))
(vl-string-search ">%" (vla-fieldcode obj))
(vl-string-search "{\\C" (vla-fieldcode obj))
(vl-string-search ";" (vla-fieldcode obj))
(vl-string-search "}" (vla-fieldcode obj)))

;; must have "{" "}" in order the FIELD to update
(setq txt1
(strcat
"{"
(substr (vla-fieldcode obj)
(+ (vl-string-search ";" (vla-fieldcode obj)) 2)))))

;; case 2:
(if (and (wcmatch (getvar "acadver") "16*")
(vla-fieldcode obj)
(vl-string-search "%<" (vla-fieldcode obj))
(vl-string-search ">%" (vla-fieldcode obj))
(not (vl-string-search "{\\C" (vla-fieldcode obj)))
(not (vl-string-search ";" (vla-fieldcode obj)))
(not (vl-string-search "}" (vla-fieldcode obj))))

(setq txt1 (strcat "{" (vla-fieldcode obj) "}")))

;; change the textstring
(vla-put-textstring obj txt1)

[/code]

hth

Marc'Antonio Alessi

unread,
Feb 16, 2005, 11:24:02 PM2/16/05
to
Grazie Louis per il tuo tempo, proverò subito la tua soluzione.
A buon rendere, spero.

Ciao.


Marco

0 new messages