Is this possible with LISP - Find Blocks in drawing without opening

[Andrew1979]

A friend of mine said he sometimes has to search around looking for certain blocks in drawings, but he has to open each one to find the block.

I have no idea why he needs to do this but he asked if there was a way to check / serach for, and maybe list the blocks in certain drawings without opening them?

 

Or the other option is to serach MTEXT for a certain string in an un-opened drawing

 

Is this possible? and if so, can anyone point me in the right direction as to basic code to check for these things in drawings not open?

 

Thanks

[LibertyOne]

You could write a script, batch and lisp combo that would search through a set of drawings. It would open and close the files automatically. You would need an AutoCAD version on the machine doing the process.

[pBe]

A friend of mine said he sometimes has to search around looking for certain blocks in drawings, but he has to open each one to find the block.

 

With Design Center [Ctrl+2] You can look and check if a block exist in a drawing without opening the file.

[Andrew1979]

thanks for the replies.

LibertyOne, what a great idea. Its been so long since I used it, I forgot about the good old script file.

pBe, I will try that too if that is a quicker option for him.

Thank you both, much appreciated.

[Lee Mac]

With Design Center [Ctrl+2] You can look and check if a block exist in a drawing without opening the file.

 

+1 This is probably the easiest way using existing AutoCAD functionality.

 

As an alternative, my Steal from Drawing program may be useful.

[francine2013]

On internet I found a lisp "BGREP.LSP" to find blocks: At first you select a folder, you give the name of the search block and normally it return a list but the lisp is not working. Perhaps is because I working on Autocad 2016.

Can somebody help me..Many thank

 

 

;; BGREP.LSP Copyright 1999 Tony Tanzillo

;;

;; Visual LISP ObjectDBX Example Application

;;

;; Author: Tony Tanzillo,

;; Design Automation Consulting

;;

;; http://ourworld.compuserve.com/homepages/tonyt

;; tony.tanzi...@worldnet.att.net

;;

;; This sample application demonstrates the use

;; of ObjectDBX ActiveX Services in Visual LISP.

;;

;; ObjectDBX is the database access component of

;; AutoCAD 2000 that provides an API that allows

;; AutoCAD-based applications to access .DWG files

;; directly, without the need to open them in the

;; AutoCAD drawing editor.

;;

;; ObjectDBX exposes an Automation object model

;; that is almost identical to AutoCAD's object

;; model at the database level. At the document

;; level, ObjectDBX omits all interactive objects

;; (like AcadSelectionSet and AcadUtility).

;;

;; The sample BGREP command prompts you to select

;; a folder and a wildcard search pattern. Then it

;; searches through every DWG file in the selected

;; folder and all subfolders, looking for blocks

;; with names that match the search pattern, and

;; lists their names to the console.

;;

;; Note that because this is a code example, there

;; is absolutely no error checking and there is no

;; commentary (yet).

(vl-load-com)

;; Helper function for AxDbDocument.Open()

(defun dbx-open (object filename)

(vlax-invoke-method object 'open filename)

)

;; Add element to path:

;;

(defun addpath (path item)

(if (eq (substr path (strlen path)) "\\")

(strcat path item)

(strcat path "\\" item)

)

)

;; Recursive Folder Iterator

;;

;; (map-folder )

;;

;; Where: (function )

;;

;; Apply to the name of each folder,

;; and all folders contained therein.

(defun map-folder (folder func)

(apply func (list folder))

(foreach subfolder

(vl-directory-files folder nil -1)

(if (/= (substr subfolder 1 1) ".")

(map-folder

(addpath folder subfolder)

func

)

)

)

)

;; This function uses ObjectDBX to open every

;; drawing in a specified folder, and searches

;; through same looking for blocks whose names

;; match the specified wildcard pattern.

(defun block-grep (folder pattern / name found1)

(foreach file (vl-directory-files folder "*.dwg")

(setq found1 nil)

;(showvals (list "FILE"))

(dbx-open dbxdoc (addpath folder file))

(vlax-for block (vla-get-blocks dbxdoc)

(setq name (strcase (vla-get-name block)))

(if (wcmatch name pattern)

(progn

(setq found (1+ found))

(if (not found1)

(progn

(write-line

(strcat

"File: "

(vla-get-name dbxdoc)

)

)

(setq dwgfound (1+ dwgfound))

(setq found1 t)

)

)

(write-line

(strcat

" Block: \""

name "\""

)

)

)

)

)

)

)

;; BGREP command function

(defun C:BGREP ( / dbxdoc root pattern found dwgfound)

(setq root (acet-ui-pickdir))

(setq pattern

(strcase

(getstring "\nBlock name specification : ")

)

)

(if (eq pattern "")

(setq pattern "*")

)

(setq dbxdoc

(vla-getInterfaceObject

(vlax-get-acad-object)

"ObjectDBX.AxDbDocument.17"

)

)

(textpage)

(setq found 0 dwgfound 0)

(map-folder root

'(lambda (folder)

(block-grep folder pattern)

)

)

(vlax-release-object dbxdoc)

(princ

(strcat

"\nFound "

(itoa found)

" block(s) in "

(itoa dwgfound)

" drawing(s)."

)

)

(princ)

)

;; ------------------------- BGREP.LSP ------------------------

; ODBX

; attempt to open an outside drawing and retrieve layer information

(defun C:ODBX (

; / dbxdoc root pattern found dwgfound

)

(setq zoom nil)

(initget "Yes No")

(if (= "Yes" (getkword "\nContinue? Yes, : "))

(SETQ IFNAME "c:\\indices\\oldtonewtest.dws")

(setq ifname nil)

)

;(setq ifname (dos_getfiled "Select DWG or DWS file" "c:\\indices\\" "DWGs|*.dwg|DWSs|*.dws||"))

(if ifname

(progn

(setq dbxdoc (vla-getInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16"))

(vlax-invoke-method dbxdoc (quote open) ifname)

(setq layers (vla-get-layers dbxdoc))

(princ (type layers))

(princ (vlax-dump-object layers))

(setq layercount (vla-get-count layers))

(princ "\nLAYERCOUNT: ")

(princ layercount)

(getstring "\nPress ENTER to continue...")

(setq count -1)

(while (

(setq layer (vla-item layers count))

(princ (type layer))

(princ (vlax-dump-object layer))

(setq ldata (vla-getXData layer "" (quote ldata1)(quote ldata2)))

(setq lname (vla-get-name layer))

(princ "\nLNAME: ")

(princ lname)

(princ "\nLDATA: ")

(princ ldata)

;(princ "\ndump of LDATA1: ")

;(princ (vlax-dump-object ldata1))

(princ "\nLDATA1: ")

(princ ldata1)

(princ "\nvalue of LDATA1: ")

(princ (vlax-safearray->list ldata1))

(princ "\nLDATA2: ")

(princ ldata2)

(princ "\nvalue of LDATA2: ")

(princ (setq ldata2_list (vlax-safearray->list ldata2)))

(foreach rec ldata2_list

(princ "\nTYPE REC: ")

(princ (type rec))

(if (= (quote variant)(type rec))

(princ (vlax-variant-value rec))

)

)

(if (null zoom)

(if (= "zoom" (getstring "\nPress ENTER to continue..."))

(setq zoom T)

)

)

)

(setq count 0)

(vlax-for layer (setq layers (vla-get-layers dbxdoc))

(setq count (1+ count))

(setq name (vla-get-name layer))

(princ "\nName: ")

(princ name)

;(getstring "\nPress ENTER to continue...")

)

(princ "\nCOUNT: ")

(princ count)

(getstring "\nPress ENTER to continue...")

(vlax-release-object dbxdoc)

)

(princ "\nNo file selected. ")

)

(prin1)

)

(defun-q C:TESTO()

(if (setq ename (entsel "\nSelect LINE: "))

(progn

(setq ename (car ename) vename (vlax-ename->vla-object ename))

(princ (type vename))

)

)

(prin1)

)

(defun C:LTRANS01 (

; /

)

(setq OK nil)

(if

(setq ifname

(dos_getfiled

"Select DWG or DWS file with layer translations"

"d:\\r16\\dwg\\laytrans\\"

"DWSs|*.dws|DWGs|*.dwg||"

)

)

(progn

(setq dbxdoc

(vla-getInterfaceObject

(vlax-get-acad-object)

"ObjectDBX.AxDbDocument.16"

)

)

(if

(vl-catch-all-error-p

(setq errobj

(vl-catch-all-apply

(quote vlax-invoke-method)

(list dbxdoc (quote open) ifname)

)

)

)

(princ

(strcat

(ding)

"\nError loading "

ifname

": "

(vl-catch-all-error-message errobj)

)

)

(setq OK T)

)

)

(princ "\nNo file selected. ")

)

(if OK

(progn

;(vlax-invoke-method dbxdoc (quote open) ifname)

(setq layers (vla-get-layers dbxdoc)

lcount (vla-get-count layers)

count 0

olist nil

)

;(princ "\nLCOUNT: ")

;(princ lcount)

;(getstring "\nPress ENTER to continue...")

(while (

(setq layer (vla-item layers count)

lname (vla-get-name layer)

lon (vla-get-LayerOn layer)

llock (vla-get-LayerOn layer)

;l (vla-get- layer)

lfrz (vla-get-Freeze layer)

lltype (vla-get-Linetype layer)

llwt (vla-get-Lineweight layer)

lplot (vla-get-Plottable layer)

ltcol (vla-get-TrueColor layer)

lblue (vla-get-Blue ltcol)

lbook (vla-get-BookName ltcol)

lindex (vla-get-ColorIndex ltcol)

lcmeth (vla-get-ColorMethod ltcol)

lcname (vla-get-ColorName ltcol)

lgreen (vla-get-Green ltcol)

lred (vla-get-Red ltcol)

lxdata (vla-getXData layer "" (quote lxdtyp)(quote lxdval))

lxdtls (if lxdtyp (vlax-safearray->list lxdtyp))

lxdvls (if lxdval (vlax-safearray->list lxdval))

xlen (length lxdtls)

xrec nil

xcount -1

xlist nil

count (1+ count)

trlist nil

)

(while (

(if (= (nth xcount lxdtls) 1001)

(if (= (vlax-variant-value (nth xcount lxdvls)) "ACLAYTRANS")

(setq xrec T)

(setq xrec nil)

)

(if xrec

(if (= (nth xcount lxdtls) 1000)

(setq xlist (cons (vlax-variant-value (nth xcount lxdvls)) xlist))

)

)

)

)

;(princ "\n(vlax-dump-object ltcol)")

;(princ (setq dump (vlax-dump-object ltcol)))

(princ "\n(vlax-dump-object layer)")

(princ (vlax-dump-object layer))

(showvals

(list

"lname"

"lon"

"llock"

"lfrz"

"lltype"

"llwt"

"lplot"

"ltcol"

"lblue"

"lbook"

"lindex"

"lcmeth"

"lcname"

"lgreen"

"lred"

"xlist"

)

)

;(princ (vlax-dump-object layer))

;(princ "\nLNAME: ")

;(princ lname)

;(princ "\nLON: ")

;(princ lon)

;(princ "\nTYPE LON: ")

;(showvals (list "llock" "lfrz" "lltype" "llwt" "ltcol" "lplot"))

;(princ (type lon))

;(princ "\nLXDATA: ")

;(princ lxdata)

;(princ "\nLXDTYP: ")

;(princ lxdtyp)

;(princ "\nvalue of LXDTYP: ")

;(if lxdtyp

; (princ (setq lxdtyp_list (vlax-safearray->list lxdtyp)))

; (princ "* nil *")

;(princ "\nLXDVAL: ")

;(princ lxdval)

;(princ "\nvalue of LXDVAL: ")

;(if lxdval

; (princ (setq lxdval_list (vlax-safearray->list lxdval)))

; (princ "* nil *")

;(foreach rec lxdval_list

; (princ "\nVALUE OF REC: ")

; (if (= (quote variant)(type rec))

; (princ (vlax-variant-value rec))

; )

(setq olist

(cons

(list

lname ; layer in target file

xlist ; all layers mapped to it by LAYTRANS

(if (= lon :vlax-true) "on" "off")

(if (= lfrz :vlax-true) "frozen" "thawed")

(if (= llock :vlax-true) "locked" "unlocked")

(if (= lplot :vlax-true) "plottable" "unplottable")

lltype

(cond

((= llwt acLnWtByLayer) "bylayer")

((= llwt acLnWtByBlock) "byblock")

((= llwt acLnWtByLwDefault) "default")

((= llwt acLnWt000) "minimum")

(T (strcat (rtos (/ llwt 100.0) 2 2) " mm"))

)

(cond

((= lcmeth acColorMethodByRGB)

(if (= lcname "")

(strcat "RGB " (itoa lred) "," (itoa lgreen) "," (itoa lblue))

(strcat lbook "/" lcname)

)

)

((= lcmeth acColorMethodByACI)

(itoa lindex)

)

(T "")

)

)

olist

)

)

(if (null zoom)

(if (= "zoom" (getstring "\nPress ENTER to continue..."))

(setq zoom T)

)

)

)

(vlax-release-object dbxdoc)

)

)

(prin1)

)

(defun-q C:TESTO()

(if (setq ename (entsel "\nSelect LINE: "))

(progn

(setq ename (car ename) vename (vlax-ename->vla-object ename))

(princ (type vename))

)

)

(prin1)

)

(defun-q C:CLEAN()

(princ (vlax-release-object dbxdoc))

(prin1)

)

; LTRANS

; shell for LAYTRANS that attempts to save the on-off and

; thawed-frozen state through translation

(defun C:LTRANS (

; /

)

(setq OK nil)

(if

(setq ifname

(dos_getfiled

"Select DWG or DWS file with layer translations"

"d:\\r16\\dwg\\laytrans\\"

"DWSs|*.dws|DWGs|*.dwg||"

)

)

(progn

(setq dbxdoc

(vla-getInterfaceObject

(vlax-get-acad-object)

"ObjectDBX.AxDbDocument.16"

)

)

(if

(vl-catch-all-error-p

(setq errobj

(vl-catch-all-apply

(quote vlax-invoke-method)

(list dbxdoc (quote open) ifname)

)

)

)

(princ

(strcat

(ding)

"\nError loading "

ifname

": "

(vl-catch-all-error-message errobj)

)

)

(setq OK T)

)

)

(princ "\nNo file selected. ")

)

(if OK

(progn

(setq retval (get_layer_info dbxdoc)

olist (car retval)

olist2 (cadr retval)

)

;(vlax-release-object dbxdoc)

(setq curdoc (vla-get-ActiveDocument (vlax-get-acad-object))

retval (get_layer_info curdoc)

ilist (car retval)

ilist2 (cadr retval)

)

) ; end progn

)

(prin1)

)

; GET_LAYER_INFO(DOC) returns a list of OLIST and OLIST2

(defun-q get_layer_info(doc

/ layers lcount count olist olist2

layer lname lon lfrz llock lltype

llwt lplot ltcol lblue lbook lindex

lcmeth lcname lgreen lred lxdata

lxdtyp lxval lxdtls lxdvls xlen

xrec xcount

)

(setq layers (vla-get-layers doc)

lcount (vla-get-count layers)

count 0

olist nil

olist2 nil

)

(while (

(setq layer (vla-item layers count)

lname (vla-get-name layer)

lon (vla-get-LayerOn layer)

lfrz (vla-get-Freeze layer)

llock (vla-get-Lock layer)

lltype (vla-get-Linetype layer)

llwt (vla-get-Lineweight layer)

lplot (vla-get-Plottable layer)

ltcol (vla-get-TrueColor layer)

lblue (vla-get-Blue ltcol)

lbook (vla-get-BookName ltcol)

lindex (vla-get-ColorIndex ltcol)

lcmeth (vla-get-ColorMethod ltcol)

lcname (vla-get-ColorName ltcol)

lgreen (vla-get-Green ltcol)

lred (vla-get-Red ltcol)

lxdata (vla-getXData layer "" (quote lxdtyp)(quote lxdval))

lxdtls (if lxdtyp (vlax-safearray->list lxdtyp))

lxdvls (if lxdval (vlax-safearray->list lxdval))

xlen (length lxdtls)

xrec nil

xcount -1

xlist nil

count (1+ count)

)

(while (

(if (= (nth xcount lxdtls) 1001)

(if (= (vlax-variant-value (nth xcount lxdvls)) "ACLAYTRANS")

(setq xrec T)

(setq xrec nil)

)

(if xrec

(if (= (nth xcount lxdtls) 1000)

(setq xlist (cons (vlax-variant-value (nth xcount lxdvls)) xlist))

)

)

)

)

(setq olist

(cons

(list

lname ; layer in target file

xlist ; all layers mapped to it by LAYTRANS

(if (= lon :vlax-true) "on" "off")

(if (= lfrz :vlax-true) "frozen" "thawed")

(if (= llock :vlax-true) "locked" "unlocked")

(if (= lplot :vlax-true) "plottable" "unplottable")

lltype

(cond

((= llwt acLnWtByLayer) "bylayer")

((= llwt acLnWtByBlock) "byblock")

((= llwt acLnWtByLwDefault) "default")

((= llwt acLnWt000) "minimum")

(T (strcat (rtos (/ llwt 100.0) 2 2) " mm"))

)

(cond

((= lcmeth acColorMethodByRGB)

(if (= lcname "")

(strcat "RGB " (itoa lred) "," (itoa lgreen) "," (itoa lblue))

(strcat lbook "/" lcname)

)

)

((= lcmeth acColorMethodByACI)

(itoa lindex)

)

(T "")

)

)

olist

)

)

(setq olist2

(cons

(list

(cons "Name" lname)

(list "Laytrans_names" xlist)

(cons "LayerOn" lon)

(cons "Freeze" lfrz)

(cons "Lock" llock)

(cons "Linetype" lltype)

(cons "Plottable" lplot)

(cons "Blue" lblue)

(cons "BookName" lbook)

(cons "ColorIndex" lindex)

(cons "ColorMethod" lcmeth)

(cons "ColorName" lcname)

(cons "Green" lgreen)

(cons "Red" lred)

)

olist2

)

)

)

(list olist olist2)

)

; BLOXIN shows stuff about BLOCKs defined in an external drawing file.

(defun-q C:BLOXIN (

; /

)

(setq OK nil)

(if bloxin_ifname

(if (= (quote str)(type bloxin_ifname))

(if (null (dos_filep bloxin_ifname))

(setq bloxin_ifname (defdir))

)

(setq bloxin_ifname (defdir))

)

(setq bloxin_ifname (defdir))

)

(if

(setq ifname

(getfiled

"Select .DWG file"

bloxin_ifname

"dwg"

0

)

)

(progn

(setq bloxin_ifname ifname)

(setq dbxdoc

(vla-getInterfaceObject

(vlax-get-acad-object)

"ObjectDBX.AxDbDocument.17"

)

)

(if

(vl-catch-all-error-p

(setq errobj

(vl-catch-all-apply

(quote vlax-invoke-method)

(list dbxdoc (quote open) ifname)

)

)

)

(princ

(strcat

(ding)

"\nError loading "

ifname

": "

(vl-catch-all-error-message errobj)

)

)

(setq OK T)

)

)

(princ "\nNo file selected. ")

)

(if OK

(progn

(princ "\nDo some stuff...")

(vlax-dump-object dbxdoc)

(setq blox (vla-get-blocks dbxdoc))

(getstring "\nPress to continue. ")

;(princ (vlax-release-object dbxdoc))

)

)

(prin1)

)