TheSwamp
Code Red => VB(A) => Topic started by: jp_lujan on October 20, 2006, 06:39:02 AM
-
Hello:
I have a file of excel with 2 columns, one is the old text and another one the new text that I want to replace in a drawing.
It would thank an aid to be able to make a macro in vba for this one task was the most automated possible.
Thanks beforehand
-
jp, what have you got so far?
What part do you need help in.
Are you working from cad or xcel
where is the text in the dwg?
-
Hello:
I have a file of excel with 2 columns, one is the old text and another one the new text that I want to replace in a drawing.
It would thank an aid to be able to make a macro in vba for this one task was the most automated possible.
Thanks beforehand
Oh, my bad
I have forgot you need this code on VBA and
I have wrote it on VLisp :|
Anyway you could be to try it
Copy code to Notepad and save as "fre.lsp" somewhere
Open Exel and select all of the cells in two columns
make sure you do not include headers if these will be there
Minimize Excel window but do not close it
Open AutoCad and run lisp
Hth
Fatty
~'J'~
;--------code start--------;
(defun get-excel-data (/ ExcData xlApp xlBook xlCell xlRange xlSheet)
(if (not (setq xlApp (vlax-get-object "Excel.Application")))
(setq xlApp (vlax-create-object "Excel.Application"))
)
(if xlApp
(progn
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda ()
(setq
xlBook (vlax-get-property xlApp "ActiveWorkBook")
)
)
)
)
)
)
(progn
(vlax-invoke-method xlBook "Activate")
(setq xlSheet (vlax-get-property xlBook "ActiveSheet"))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda ()
(setq xlRange (vlax-get-property xlApp "Selection"))))))
(setq xlRange (vlax-get-property xlSheet "UsedRange")))
(setq ExcData (vlax-safearray->list
(vlax-variant-value
(vlax-get-property xlRange "Value")
)
)
) ;or Value2
(setq ExcData
(mapcar (function
(lambda (x) (mapcar 'vlax-variant-value x))
)
ExcData
)
)
(vlax-invoke-method xlApp "Quit")
)
)
(mapcar (function (lambda (x)
(vl-catch-all-apply
(function (lambda ()
(progn
(vlax-release-object x)
(setq x nil)
)
)
)
)
)
)
(list xlCell xlRange xlSheet xlBook xlApp)
)
)
)
(gc)
ExcData
)
; ------------------------------------------;
(defun newstring (old new str)
(while
(vl-string-search old str)
(setq str (vl-string-subst new old str))))
; ------------------------------------------;
(defun C:FRE ()
(vl-load-com)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
)
(vla-endundomark
adoc)
(vla-startundomark
adoc)
(setq repList (get-excel-data))
(vla-zoomall (vlax-get-acad-object))
(setq ss (ssget "_X" (list (cons 0 "*TEXT"))))
(setq axss (vla-get-activeselectionset adoc))
(vlax-for a axss
(setq strRep (vlax-get-property a "TextString"))
(while (vl-some (function (lambda(x)
(vl-string-search x strRep)))
(mapcar 'car repList))
(setq newStr
(car
(vl-remove-if 'not
(mapcar (function (lambda(a b)(newstring a b strRep)))
(mapcar 'car repList)(mapcar 'cadr repList)))))
(setq strRep newStr))
(vlax-put-property a "TextString" newStr)
(vla-update a))
(vla-endundomark
adoc)
(princ)
)
(prompt "\n\t\t * Type FRE to execute... *")
(princ)
; TesT :(C:FRE)
;--------code end--------;
-
Here is almost the same on VBA
:-)
~'J'~
-
iam sorry but could you please modify this lisp so that it process the objects not more than one time (texts processed multiple times and the final result isn't the desired one.. thanks in advance