Copy Nested Text

I'm looking for a lisp similar to the express command "copy nested entities" but I need one that will copy nested text and keep the text as is, not just copy the attribute the way it originally is.

 

So you want one that copys text, and attribute information into text?

Tim

 

Yeah, that sounds about what I'm looking for.

 

See how this works for you.

Tim

(defun c:CpNestedText (/ ActDoc CurSpace Ent Obj Ali InsPt TxtHt TxtRot TxtStr TxtWd
tmpObj tmpType tmpEnt tmpObj2 tmpPt tmpInsPt)

(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq CurSpace (GetCurrentSpace ActDoc))
(vla-StartUndoMark ActDoc)
(if
(and
(setq Ent (nentsel "\n Select text\/attribute object: "))
(setq tmpType (cdr (assoc 0 (entget (car Ent)))))
(or
(= tmpType "TEXT")
(= tmpType "MTEXT")
(= tmpType "ATTRIB")
)
)
(progn
(setq Obj (vlax-ename->vla-object (car Ent)))
(setq InsPt (vla-get-InsertionPoint Obj))
(setq TxtHt (vla-get-Height Obj))
(setq TxtRot (vla-get-Rotation Obj))
(setq TxtStr (vla-get-TextString Obj))
(cond
((or
(= tmpType "TEXT")
(= tmpType "ATTRIB")
)
(setq tmpObj (vla-AddText CurSpace TxtStr InsPt TxtHt))
(setq Ali (vla-get-Alignment Obj))
(if (/= Ali 0)
(progn
(vla-put-Alignment tmpObj Ali)
(setq InsPt (vlax-get Obj 'TextAlignmentPoint))
(vla-put-TextAlignmentPoint tmpObj (vla-get-TextAlignmentPoint Obj))
)
(setq InsPt (vlax-get Obj 'InsertionPoint))
)
(if
(and
(= tmpType "TEXT")
(not (numberp (car (last Ent))))
)
(progn
(setq tmpEnt (car (last Ent)))
(setq tmpObj2 (vlax-ename->vla-object tmpEnt))
(setq tmpPt (vlax-get tmpObj2 'InsertionPoint))
(setq tmpInsPt (mapcar '(lambda (a b) (+ a b)) tmpPt InsPt))
(if (= Ali 0)
(vla-put-InsertionPoint tmpObj (vlax-3d-point tmpInsPt))
(vla-put-TextAlignmentPoint tmpObj (vlax-3d-point tmpInsPt))
)
)
)
)
((= tmpType "MTEXT")
(setq TxtWd (vla-get-Width Obj))
(setq tmpObj (vla-AddMText CurSpace InsPt TxtWd TxtStr))
)
)
(vla-put-Rotation tmpObj TxtRot)
)
(prompt "\n Nothing selected. ")
)
(vla-EndUndoMark ActDoc)
(princ)
)

(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jason Piercey
;(defun activeSpaceObject (document) His Name for it

(vla-get-block
(vla-get-activelayout Doc)
)
)

 

Code:

(defun C:ALE_COPY_STRING ( / EntNam EntDat ValStr EntLs1 EntLs2 PrmStr)
;_i__ (setq PrmStr "\nSeleziona la Stringa da copiare: ")
;|e|; (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
;_i__   (setq PrmStr "\nSeleziona la Stringa da copiare [Invio per
terminare]: ")
;_i__   (initget "Multiplo")
;_i__   (if (= "Multiplo" (setq EntLs2 (nentsel "\nSeleziona la Stringa su
cui copiare il valore [Multiplo]: ")))
;|e|;   (setq PrmStr "\nSelect origin String [Return to quit]: ")
;|e|;   (initget "Multiple")
;|e|;   (if (= "Multiple" (setq EntLs2 (nentsel "\nSelect the target String
[Multiple]: ")))
(while
;_i__       (setq EntLs2 (nentsel "\nSeleziona la Stringa su cui copiare il
valore [Invio per terminare]: "))
;|e|;       (setq EntLs2 (nentsel "\nSelect the target String [Return to
quit]: "))
(ALE_UPD_STRING EntLs1 EntLs2 ValStr)
)
(ALE_UPD_STRING EntLs1 EntLs2 ValStr)
)
);progn
;_i__ (princ "\nNessuna Stringa selezionata! Riprova. ")
;|e|; (princ "\nNo String selected! Try again. ")
);if
);while
(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)
)
)
)
)
(if (entmod (subst (cons 1 ValStr) (assoc 1 EntDt2) EntDt2))
(entupd EntNm2)
;_i__   (alert "La funzione ENTMOD ha avuto esito negativo.")
;|e|;   (alert "ENTMOD error.")
)
)
;_i__ ( T (princ "\nNessuna Stringa selezionata! Ricomincia. ") )
;|e|; ( T (princ "\nNo String selected! Restart. ") )
)
)

(defun DXF (code elist)
(cdr (assoc code elist))
)
[code]
--

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

--

 

Hi Tim,

A couple thoughts which might help.

Use the CopyObjects method rather than Add. That will save some code. And you can
copy any object from a block reference rather than limiting the function to only text
type objects.

Your function does not deal with the fact the block containing the (text) object may
be rotated and/or scaled. Use vla-transformby as below.

See my comments. Yes, I'm ignoring the OP request to copy attributes as text.

Code:

;; revised 2/8/2005 - originally posted 3/16/2004
;; copy and select a model space object nested in a block reference
;; not intended for use with xrefs or block attributes
;; rough code for demonstration only
(defun c:CopyNested ( / doc mspace ent vobj matrix copyobj )
(and
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq mspace (vla-get-ModelSpace doc))
(setq ent (nentselp "Select object nested in block: "))
(setq vobj (vlax-ename->vla-object (car ent)))
(setq matrix (caddr ent)) ;4x4 transformation matrix
(setq copyobj (car (vlax-invoke doc 'copyobjects (list vobj) mspace)))
(not (vla-transformby copyobj (vlax-tmatrix matrix)))
(not (vla-update copyobj))
(sssetfirst nil (ssget "L"))
)
(princ)
) ;end

Regards
Joe Burke

 

Thanks Tim, that works pretty good.

David

 

Hey Joe,

I know my routine wouldn't work correctly with blocks that have been rotated or scaled. I didn't have that much time to spend. This was like a training for me because I've never done it before, and I wanted to see if it was hard.

Thanks for the tips, and you works good also. I will keep it and learn from it.

How did you know CopyObject would work? I'm not really up to speed on matrixes, so thanks for that example also.

Tim

 

Tim,

You're welcome.

Regarding copyobjects and matricies, it's something James Allen and I have been
kicking around in various topics over the last year or so. James has a better handle
on it than I do. He has posted functions which deal with the issues. My sense is they
haven't attracted the attention they deserve.

I guess what I'm trying to say is stepping over the copy from block line is fairly
complicated if you intend to do it right. Xrefs must be dealt with as well as objects
nested many levels deep within a block. That condition needs a function which
considers and applies multiple transformation matricies in the correct order.

Unfortunately neither AutoLisp or VLisp provide such functions, as far as I know. And
NCOPY in ExpessTools doesn't work very well. As I recall, it fails in a rotated UCS.

BTW, I did think about the copy attribute as text thing. I don't see a way to do it
other than what you posted. I'm aware, in that sense, your post answers the original
question in a more direct fashion than what I posted.

Regards
Joe Burke

 

Thanks for the info Joe. I have read the post where you and James have been talking about matrixes, but didn't really get it because I didn't have any routines at the time that could use it. Maybe I will try and write one like yours that uses a matrix.

Tim