Modify Existing LISP - Lee Mac
I really like Lee's block delete LISP program and I want to try and change it to perform a different task in the same way it performs its current task. I would like to replace the block delete function with a text replace function. Unfortunately I am not familiar enough with the ObjectDBX programming language to do this by myself, so if someone can possibly guide me through making this happen I would greatly appreciate it. This is the Block Delete LISP I received from Lee Mac;; ObjectDBX Example, by Lee McDonnell;; Credit to Tony Tanzillo, Tim Willey(defun c:blkdel (/ *error* bNme *acad Shell fDir Dir dwLst dbx) (vl-load-com) ;; Error Handler (defun *error* (e) (ObjRel (list Shell dbx *acad)) (if (not (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n>"))) (princ)) ;; Get Block Name (while (progn (setq bNme (getstring t "\nSpecify Block Name: ")) (cond ((not (snvalid bNme)) (princ "\n** Invalid Block Name **")) (t (setq bNme (strcase bNme)) nil)))) ;; Get Directory (setq *acad (vlax-get-acad-object) Shell (vla-getInterfaceObject *acad "Shell.Application") fDir (vlax-invoke-method Shell 'BrowseForFolder (vla-get-HWND *acad) "Select Directory: " 80)) (and (eq (type Shell) 'VLA-OBJECT) (not (vlax-object-released-p Shell)) (vl-catch-all-apply 'vlax-release-object (list Shell))) (if fDir (progn (setq Dir (vlax-get-property (vlax-get-property fDir 'Self) 'Path)) (if (not (eq "\\" (substr Dir (strlen Dir)))) (setq Dir (strcat Dir "\\"))) (princ "\nProcessing...") ;; Iterate Drawings (foreach dwg (setq dwLst (mapcar (function (lambda (x) (strcat Dir x))) (vl-directory-files Dir "*.dwg" 1))) (vlax-for doc (vla-get-Documents *acad) (and (eq (strcase (vla-get-fullname doc)) (strcase dwg)) (setq dbx doc))) (and (not dbx) (setq dbx (vlax-create-object (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))) (progn (vlax-for lay (vla-get-Layouts dbx) (vlax-for Obj (vla-get-Block lay) (if (and (eq (vla-get-ObjectName Obj) "AcDbBlockReference") (eq (strcase (vla-get-Name Obj)) BNme)) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list Obj))) (princ (strcat "\n** Error Deleting Block in: " (vl-filename-base dwg) " **")))))) (vla-saveas dbx dwg)) (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg) " **"))) (princ (chr 46))) ;; Ending Messages (princ (strcat "\n>"))) (princ "*Cancel*")) ;; Garbage Collection(gc) (ObjRel (list Shell dbx *acad)) (princ));; Release Objects ~ Requires List of Variables (defun ObjRel (lst) (mapcar (function (lambda (x) (if (and (eq (type x) 'VLA-OBJECT) (not (vlax-object-released-p x))) (vl-catch-all-apply 'vlax-release-object (list x))))) lst))
What I like most about this program is how quickly it is able to go through all the drawings and perform this task. I would love to be able to figure out what I need to remove in order to change the task it performs, because this is a perfect way to perform tasks on a folder full of drawings. Lee Mac has left the building (he's back at school) but I'm sure someone else can offer some insight into your problem. Please do... I realized Lee was away. I wasn't trying to direct it just to him. Hello,
Sorry I don't have a solution, I think there are others on this forum who will hopefully help you out more, I can just tell you what I've learnt from using Lee's ObjectDBX template if you want to edit it there are two area's that you should concerntrate on (Highlighted in Blue). The rest is just concerned with the drawings:
;; ObjectDBX Example, by Lee McDonnell;; Credit to Tony Tanzillo, Tim Willey(defun c:blkdel (/ *error* bNme *acad Shell fDir Dir dwLst dbx) (vl-load-com) ;; Error Handler (defun *error* (e) (ObjRel (list Shell dbx *acad)) (if (not (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n>"))) (princ)) ;; Get Block Name(while (progn (setq bNme (getstring t "\nSpecify Block Name: ")) (cond ((not (snvalid bNme)) (princ "\n** Invalid Block Name **")) (t (setq bNme (strcase bNme)) nil)))) ;; Get Directory (setq *acad (vlax-get-acad-object) Shell (vla-getInterfaceObject *acad "Shell.Application") fDir (vlax-invoke-method Shell 'BrowseForFolder (vla-get-HWND *acad) "Select Directory: " 80)) (and (eq (type Shell) 'VLA-OBJECT) (not (vlax-object-released-p Shell)) (vl-catch-all-apply 'vlax-release-object (list Shell))) (if fDir (progn (setq Dir (vlax-get-property (vlax-get-property fDir 'Self) 'Path)) (if (not (eq "\\" (substr Dir (strlen Dir)))) (setq Dir (strcat Dir "\\"))) (princ "\nProcessing...") ;; Iterate Drawings (foreach dwg (setq dwLst (mapcar (function (lambda (x) (strcat Dir x))) (vl-directory-files Dir "*.dwg" 1))) (vlax-for doc (vla-get-Documents *acad) (and (eq (strcase (vla-get-fullname doc)) (strcase dwg)) (setq dbx doc))) (and (not dbx) (setq dbx (vlax-create-object (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))) (progn (vlax-for lay (vla-get-Layouts dbx) (vlax-for Obj (vla-get-Block lay) (if (and (eq (vla-get-ObjectName Obj) "AcDbBlockReference") (eq (strcase (vla-get-Name Obj)) BNme)) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list Obj))) (princ (strcat "\n** Error Deleting Block in: " (vl-filename-base dwg) " **")))))) (vla-saveas dbx dwg)) (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg) " **"))) (princ (chr 46))) ;; Ending Messages (princ (strcat "\n>"))) (princ "*Cancel*")) ;; Garbage Collection(gc) (ObjRel (list Shell dbx *acad)) (princ));; Release Objects ~ Requires List of Variables (defun ObjRel (lst) (mapcar (function (lambda (x) (if (and (eq (type x) 'VLA-OBJECT) (not (vlax-object-released-p x))) (vl-catch-all-apply 'vlax-release-object (list x))))) lst))
As you can see it uses the blocks table. Now the problem with ObjectDBX is you can't use ssget function, therefore it is great for blocks, attributes, layers, any tables, but not for individual objects like text. Because how can you search the drawing without the ssget function? I'm not sure if entnext will work but if it does it's guaranteed to take a looong time.
But yeah, hopefully others can shed light on this... Thanks for the hints... I will try to play with it a little. Yeah I hope someone more knowledgeable will be able to say straight up whether it is doable or not... You can't use ent* functions with ODBX and there isn't a way to make a selection set. You will have to actually open the drawing to accomplish this. I know it's not what you want to hear, I know it's not what I want tell you. I haven't tried it, but would that mean you may just be able to use entnext to search through a drawing? I'm sure it'd be incredibly slow, but if you were looking for a specific text string:
(setq oldtxtstr "hello" newtxtstr "goodbye" a (entnext))(while (setq a (entnext a)) (if (and (eq (cdr (assoc 0 (entget a))) "TEXT") (eq (cdr (assoc 1 (entget a))) txtstr)) (entmod (subst (cons 1 newtxtstr) (assoc 1 (entget a)) (entget a))) ) ) Sorry, made a typo. Pretty pivotal mistake, sorry. You can't use ent* methods.
Here is an example with entmod or vlax-put:
;; ObjectDBX Example, by Lee McDonnell;; Credit to Tony Tanzillo, Tim Willey;; RJP edit to replace strings 10.24.09, Must be correct case when looking for string, Replaces all occurrences in the string(defun c:fndreplace (/ rjp-replacetext *error* *acad acver dbx dir dwlst ent fdir layouts newstringoldstring shell txt ) (vl-load-com) ;; Error Handler (defun rjp-replacetext (string old new) (while (vl-string-search old string) (setq string (vl-string-subst new old string)) ) string ) (defun *error* (e) (objrel (list shell dbx *acad)) (if (not (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n>")) ) (princ) ) ;; Get Block Name (if (and (setq oldstring (getstring t "\nSpecify string to replace: ")) (setq newstring (getstring t "\nSpecify replacement string: ")) ) (progn ;; Get Directory (setq *acad (vlax-get-acad-object) shell (vla-getinterfaceobject *acad "Shell.Application") fdir(vlax-invoke-method shell 'browseforfolder (vla-get-hwnd *acad) "Select Directory: " 80 ) ) (and (eq (type shell) 'vla-object) (not (vlax-object-released-p shell)) (vl-catch-all-apply 'vlax-release-object (list shell)) ) (if fdir (progn (setq dir (vlax-get-property (vlax-get-property fdir 'self) 'path)) (if (not (eq "\\" (substr dir (strlen dir)))) (setq dir (strcat dir "\\")) ) (princ "\nProcessing...") ;; Iterate Drawings (foreach dwg (setq dwlst (mapcar (function (lambda (x) (strcat dir x))) (vl-directory-files dir "*.dwg" 1) ) ) (vlax-for doc (vla-get-documents *acad) (and (eq (strcase (vla-get-fullname doc)) (strcase dwg)) (setq dbx doc) ) ) (and (not dbx) (setq dbx (vlax-create-object (if (< (setq acver (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acver)) ) ) ) ) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg))) (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg) " **") ) (progn (setq layouts (vla-get-layouts dbx)) (vlax-for lay layouts (vlax-for obj (vla-get-block lay) (if (and (member (vla-get-objectname obj) '("AcDbText" "AcDbMText")) (wcmatch (strcase (setq txt (vlax-get obj 'textstring))) (strcase (strcat "*" oldstring "*")) ) (setq ent (vlax-vla-object->ename obj)) ) (progn ;; (entmod (subst (cons 1 newstring) ;; (assoc 1 (entget ent)) ;; (entget ent) ;; ) ; (vlax-put obj 'textstring (rjp-replacetext txt oldstring newstring) ) (princ "\nChanged text...") ) ) ) ) (vla-saveas dbx dwg) ) ) (princ (chr 46)) ) ;; Ending Messages (princ (strcat "\n>")) ) (princ "*Cancel*") ) ;; Garbage Collection (gc) (objrel (list shell dbx *acad)) (princ) ) ));; Release Objects ~ Requires List of Variables(defun objrel (lst) (mapcar (function (lambda (x) (if (and (eq (type x) 'vla-object) (not (vlax-object-released-p x))) (vl-catch-all-apply 'vlax-release-object (list x)) ) ) ) lst ))
页:
[1]
2