TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on December 08, 2010, 09:12:35 AM
-
Can some show me how to replace only part of an attribute? For instance, "3021920" is an attribute and I want to change "30" to "GF" but leave the rest of the attribute as is so the final result would be "GF21920". I have numerous blocks with this and I need a simplified way to globally make the change. Any help appreciated.
Thanks
-
I thought Lee or Tim had a "Find and Replace" that worked on attributes and allowed wild cards.
(Replace "30*" "GF")
But you may need to use the block name and / or attribute Tag Name as a filter too to prevent text from getting hit.
-
Something like this?
(defun c:test ( / *error* RegEx ss ) (vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(LM:ReleaseObject RegEx)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (ssget "_X" '((0 . "INSERT") (66 . 1)))
(progn
(setq RegEx (vlax-create-object "VBScript.RegExp"))
(mapcar '(lambda ( x ) (vlax-put-property RegEx (car x) (cdr x)))
(list
(cons 'pattern "^30(.*)")
(cons 'global acfalse)
(cons 'ignorecase acfalse)
)
)
(vlax-for obj
(setq ss
(vla-get-ActiveSelectionSet
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(mapcar
(function
(lambda ( a / s n )
(if (not (eq (setq s (vla-get-TextString a))
(setq n (vlax-invoke RegEx 'replace s "GF$1"))))
(vla-put-TextString a n)
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
(LM:ReleaseObject RegEx)
)
)
(princ)
)
;;------------------=={ Release Object }==--------------------;;
;; ;;
;; Releases a VLA Object from memory via plentiful error ;;
;; trapping ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; obj - VLA Object to be released from memory ;;
;;------------------------------------------------------------;;
;; Returns: T if Object Released, else nil ;;
;;------------------------------------------------------------;;
(defun LM:ReleaseObject ( obj ) (vl-load-com)
;; © Lee Mac 2010
(and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-release-object) (list obj)
)
)
)
)
)
EDIT: Had it the wrong way round ...
-
Lee
I can make use of this.
Quick question, how would I update all patterns containing the following:
(cons 'pattern "^1-1-1-1(.*)")
(cons 'pattern "^2-1-1-1(.*)")
(cons 'pattern "^2-1-3-1(.*)")
within one the same argument of the routine?
-
I would say use:
"^[12]-1-[13]-1(.*)"
but this would include:
"^1-1-3-1(.*)"
among others.
-
Thanks Lee
I can use this routine to update my room name with floor finsh block. I would replace all of the floor finishes:
1-1-1-1, 2-1-3-1 and so on with a blank setting.
(cons 'pattern "^[123456]-[123456]-[123456]-[123456](.*)")
(setq n (vlax-invoke RegEx 'replace s "$1"))))
This is really neat, a simple way to update all of the floor finishes with a unit or building plan with a (nil) finishes, but still keepig the block room names intact.
Thanks
-
You're welcome Gary, glad you could get some use out of it :-)
You could replace:
(cons 'pattern "^[123456]-[123456]-[123456]-[123456](.*)")
With:
(cons 'pattern "^[1-6]-[1-6]-[1-6]-[1-6](.*)")
to achieve the same result.
Reference here (http://msdn.microsoft.com/en-us/library/f97kw5ka%28v=VS.85%29.aspx) :-)
-
I can use this routine to update my room name with floor finsh block. I would replace all of the floor finishes:
1-1-1-1, 2-1-3-1 and so on with a blank setting
By 'blanking' do you mean setting the attribute to an empty string? ( "" )
If so, this could be done using wcmatch:
(if (wcmatch (vla-get-TextString a) "[1-6]-[1-6]-[1-6]-[1-6]*")
(vla-put-TextString a "")
)
And you wouldn't need to go the RegExp route.
-
Yes, "" is my blank
How would you modify it to include all characters, for example:
1-1(2)-4-1
-
I'm not sure what you mean by 'all characters', but maybe some combination of this?
(defun c:test ( / ss ) (vl-load-com)
;; © Lee Mac 2010
(if (ssget "_X" '((0 . "INSERT") (66 . 1)))
(progn
(vlax-for obj
(setq ss
(vla-get-ActiveSelectionSet
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(mapcar
(function
(lambda ( a / s n )
(if (wcmatch (vla-get-TextString a) "[color=red]#-*-#-#*[/color]")
(vla-put-TextString a "")
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
)
)
(princ)
)
If need be, you could also add extra conditions on the attribute involving the Tag String.
-
Wow, now that is kool.
I should have said any character.
That did the job.
I have got to lean this vla-complictedstuff and wildcards.
Thanks again
-
Thanks Gary :-)
The VLIDE has quite a good entry on wcmatch, certainly enough to help you understand my example above :-)
-
You're welcome Gary, glad you could get some use out of it :-)
You could replace:
(cons 'pattern "^[123456]-[123456]-[123456]-[123456](.*)")
With:
(cons 'pattern "^[1-6]-[1-6]-[1-6]-[1-6](.*)")
to achieve the same result.
Reference here (http://msdn.microsoft.com/en-us/library/f97kw5ka%28v=VS.85%29.aspx) :-)
That RexExp is some cool schtuff :-)
-
That RexExp is some cool schtuff :-)
Definitely :-)
-
Thanks again you guys, I can make good use of this routine.
Modified it to cover many different combinations:
(defun ARCH:Finish (1st 2nd / *error* ss ) (vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (ssget "_X" '((0 . "INSERT") (66 . 1)))
(progn
(vlax-for obj
(setq ss
(vla-get-ActiveSelectionSet
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(mapcar
(function
(lambda ( a / s n )
(if (wcmatch (vla-get-TextString a) 1st)
(vla-put-TextString a 2nd)
)
)
)
(vlax-invoke obj 'GetAttributes)
)
)
(vla-delete ss)
)
)
(princ)
)
(defun c:TileFinish ()(ARCH:Finish "2-1-1-1" "4-1-1-1"))
(defun c:VCTFinish ()(ARCH:Finish "4-1-1-1" "2-1-1-1"))
(defun c:HallcarpetFinish ()(ARCH:Finish "3-*-1-1" "1-1(4)-1-1"))
(defun c:HallconcreteFinish ()(ARCH:Finish "1-*-1-1" "3-1(4)-1-1"))
(defun c:RoomFinishNil ()(ARCH:Finish "#-*-#-#*" ""))
-
Nice one Gary, I like it :-)
-
Just being picky but s and n seem to be artifacts, no?
(lambda ( a /[color=red] s n [/color])
(if (wcmatch (vla-get-TextString a) 1st)
(vla-put-TextString a 2nd)
)
)
-
Just being picky but s and n seem to be artifacts, no?
Good catch Alan :-)
-
I'm glad I saw this thread.
I've been having a problem blanking null value attributes since upgrading autocad. In 2005 I could use find and then replace with nothing.
Since upgrading to 2009 you can't replace with nothing, a value has to be entered in the "replace with" box.
but
(defun c:nv ()(nullvalues "-999.00" ""))
works a treat thanks Lee and GDF!