Jump to content

Modify Existing LISP - Lee Mac


AQucsaiJr

Recommended Posts

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<< Error: " e " >>")))
   (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<< " (rtos (length dwLst) 2 0) " Drawings Processed >>")))
   (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.

Link to comment
Share on other sites

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<< Error: " e " >>")))
   (princ))

 ;; Get Block Name

[color=Blue]  (while
   (progn
     (setq bNme (getstring t "\nSpecify Block Name: "))
     (cond ((not (snvalid bNme))
            (princ "\n** Invalid Block Name **"))
           (t (setq bNme (strcase bNme)) nil))))     [/color]

 ;; 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
[color=Blue]            (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) " **"))))))[/color]
           (vla-saveas dbx dwg))
         (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg) " **")))

       (princ (chr 46)))     
             
     ;; Ending Messages
     
     (princ (strcat "\n<< " (rtos (length dwLst) 2 0) " Drawings Processed >>")))
   (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...

Link to comment
Share on other sites

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. :(

Link to comment
Share on other sites

You can 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)))
   )
 )

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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       newstring  oldstring     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<< Error: " e " >>"))
   )
   (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<< " (rtos (length dwlst) 2 0) " Drawings Processed >>"))
   )
   (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
 )
)

Link to comment
Share on other sites

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       newstring  oldstring     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<< Error: " e " >>"))
   )
   (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<< " (rtos (length dwlst) 2 0) " Drawings Processed >>"))
   )
   (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
 )
)

 

 

I guess I was wrong. I stand happily corrected. Should have just kept my mouth shut.

Link to comment
Share on other sites

Yes, that you Ron, that was extremely educating. :)

On many levels.:oops:

 

Glad to help out :). Although I only slightly modified code already posted...most of the thanks should go to Lee. 8)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...