wblock vlisp to just output objects drawn and visible in modelspace

[ralstogj]

Hi

I am trying to write a lisp to just wblock out to a clean drawing all the visible objects in a drawings modelspace. I have found the code below and modified it to write the new file name as I want it but am having trouble getting a selectionset of just objects shown in model space and get a selection set to pass to the wblock function. If anyone has some example code for functions that do this they could share that would be appreciated.

(defun c:al-wblock ()

;wblocks block out all objects in modelspace even if layer off or forzen
;original code source from here
;https://www.afralisp.net/archive/methods/list/wblock_method.htm

(vl-load-com)

(setq thisdrawing (vla-get-activedocument
(vlax-get-acad-object)))

(setq ssets (vla-get-selectionsets thisdrawing))

(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list ssets "$Set")))

(setq newSet (vla-add ssets "$Set"))

(progn

(vla-delete (vla-item ssets "$Set"))

(setq newSet (vla-add ssets "$Set"))

);progn

);if

;select all objects in the drawing
(vla-Select newSet acSelectionSetAll)
;;@@ update to just select objects currently visible in modelspace

;-----------------------------------Added by JR-----------------------------------
;Add Create the name of the new file from the exisitng

;Get the existing file path
(Setq ExFilePath (getvar "dwgprefix"))

;Get the existing file name
(Setq ExFileName (getvar "dwgname"))

;Create a new file name for the wblock to write out to.
(Setq NewFilePathAndName (strcat ExFilePath "wBlocked" ExFileName))

;export the conents of just model space to a new drawing
;----------------------------------------------------------------------------------

;(vla-WBlock thisdrawing "c:/test.dwg" newSet)
(vla-WBlock thisdrawing NewFilePathAndName newSet)

(princ)

);defun

[Kent1Cooper]

---

@ralstogj wrote:

.... getting a selectionset of just objects shown in model space ....

---

(command

  "_.zoom" "_extents"

  "_.wblock" YourFileName "" (getvar 'insbase)

    "_C" (getvar 'extmax) (getvar 'extmin) ""

  "_.oops" ; to bring back into current drawing

)

[ralstogj]

Hi Kent

Thanks for the suggestion, I have given that a go and it does work but because I am using Civil3d which is based on Map i get an extra dialog box pop up which I can not seem to get past with out clicking with the mouse even with Filedia set to 0 and trying a few extra "" for enter in your code and starting civil3d just as autocad.

Hopefully some other suggestions come forward as once I have the code for wblocking finished I was wanting to run on a project folder that may have 5 to 10 drawings in it.

To do this in a batch process I am using the app BatchInEditor but because of the extra dialog the code does not want to work for me in the batch process. But is ok in a single drawing when fired manually

[john.uhden]

Please explain what you me by "visible."

Do you wish to include/exclude objects that are on frozen or off layers?

Do you wish to include/exclude objects outside the current view?

Do you wish to include/exclude objects that have their visibility turned off?

Do you wish to include/exclude objects that are hidden by wipeouts or solid hatching or 2D solids or background fills, etc.?

(That last one could be mighty difficult, if even possible.)

[Sea-Haven]

Try this for Civ3d

(setq ss2 (ssget "X" (list (cons 410 (getvar 'ctab)))))
(command "-wblock"  "d:\\acadtemp\\testdwg" "" "0,0" ss2 "" "N")

[ralstogj]

Guys,

Thanks for the comments I have been able to make something work and have posted below. The whole reason behind the code is to help in rebuilding civil3d projects quickly when the files get corrupted. Basically we split out the different disciplines into 6 or so different files and xref them all back together for the final plan sets. But some times the civil3d objects corrupt things. What I am wanting to do is copy basically everything drawn in modelspace that is not a Civil3d objects and take them out to a new drawing. The following code does that but still includes Civil3d object that I am trying to figure out how to exclude those at the moment.  

The two methods suggested  have the following issues

;this method writes but the map export dialog box still comes up

(command
"_.zoom" "_extents"
"_.wblock" "c:/temp/cad/testing3.dwg" "" (getvar 'insbase)
"_C" (getvar 'extmax) (getvar 'extmin) ""
"_.oops" ; to bring back into current drawing
)

;this method writes file as well but the map export dialog box still comes up
;also if pulls all the layer for Civil3d pipe networks and parcels if sites and networks have been defined in the drawing

(setq ss2 (ssget "X" (list (cons 410 (getvar 'ctab)))))
(command "-wblock" "c:/temp/cad/testing2method.dwg" "" "0,0" ss2 "" "N")

This code works using the  vla-wblock function and stops the map dialog coming up but you have to convert the selection set first into a visuallisp one from an Autolisp one.

(defun c:AL-WBLOCK_MODELSPACE ( / doc idx lst sel ssc vsl )

;Original code source from here
;https://www.cadtutor.net/forum/topic/56202-make-selection-set-active/
;Original code asks for user to select objects to wblock out
;---------------------------------------------------------------------------------------------------
;Following code has been updated by Justin Ralston (JR) to select just visible objects
;in modelspace by switching to modelspace, zooming to extents and then doing a crossing window selection.
;The objects are then wblocked to a file in the same directory in a new folder called "wBlockedofModelspace"
;-----------------------------------------------------------------------------------------------------

;-----------------------------------Additional Code added by JR-----------------------------------
;select all objects in modelspace of the drawing

;Make sure the drawing is in modelspace
(setvar 'ctab "MODEL")

;Zoom to extents of modelspace to refresh the modelspace extents
(command "_.zoom" "_extents")

;Get the extents of modelspace
(Setq corner1 (getvar 'extmin)) ;Get the lower corner
(Setq corner2 (getvar 'extmax)) ;Get the upper corner

;Restore the drawing Zoom to previous state
(command "_.zoom" "_previous")

;Different ssget functions
;see http://www.lee-mac.com/ssget.html
;(ssget "_C" corner1 corner2 ) ; crossing window selection
;(ssget "X" (list (cons 410 (getvar 'ctab)))) ;selects everything in modelspace even if hidden and frozen

;Exclude all Civil3d Objects
;See https://forums.augi.com/showthread.php?172844-Lisp-code-to-wblock-all-objects-except-Civil-3D-object...
;(ssget "_CP" corner1 corner2 '(0 . "~AECC*"));; work in progress does not seem to work

;---------------------------------Orginal Code by Lee Mac--------------------------------------------------

(if (setq sel (ssget "_C" corner1 corner2 ) );Changed the ssget function here to select what you want to export
;---------------------------------Orginal Code Unchanged--------------------------------------------------
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
ssc (vla-get-selectionsets doc)
vsl (vla-add ssc (uniqueitem ssc "mywb"))
)
(vla-additems vsl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)

;-----------------------------------Added by JR-----------------------------------
;Add Create the name of the new file from the exisitng

;Get the existing file path
(Setq ExFilePath (getvar "dwgprefix"))

;Get the existing file name
(Setq ExFileName (getvar "dwgname"))

;Create a new folder for the wblock to be written out to.
(Setq NewFolderpath (strcat ExFilePath "wBlockedofModelspace"))
(vl-mkdir NewFolderpath) ; no error is thrown if it exists.

;Create a new file name for the wblock to write out to.
(Setq NewFilePathAndName (strcat NewFolderpath "//" ExFileName))
(princ NewFilePathAndName)

;export the contents of just model space to a new drawing
;----------------------------------------------------------------------------------

;(vla-WBlock doc NewFilePathAndName vsl)

(vla-wblock doc

NewFilePathAndName

vsl
)

;(vla-wblock doc
; (vl-filename-mktemp
; (vl-filename-base (getvar 'dwgname)) ;Drawing Name strippped of path and extension
; (getvar 'dwgprefix) ;Drive and folderpath of current drawing
; ".dwg"
😉
;vsl
😉
(vla-delete vsl)
)
)
(princ)
)

(defun uniqueitem ( col key / int rtn )
(setq int 0)
(while
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item
(list col (setq rtn (strcat key (itoa (setq int (1+ int))))))
)
)
)
)
rtn
)

(vl-load-com) (princ)

[ralstogj]

to exclude Civil3d objects I changed the selection set to  the following line to filter them out.

(ssget "_C" corner1 corner2 '((0 . "~AECC*")))

[ralstogj · Accepted solution]

Ok I have updated the code again to include a keyword prompt for users to choose the type of selectionset filter they want to use when are making the selection set to be wblocked out.

Only problem with this I can not seem to run from the command line in the batch process using a call like

(c:AL-WBLOCK_MODELSPACE" "" "A" "") to choose one of the options is there a trick to defining your custom function so it will work like and shipped command in lisp?

(defun c:AL-WBLOCK_MODELSPACE ( / doc idx lst sel ssc vsl corner1 corner2 kword )

;Original code source from here
;https://www.cadtutor.net/forum/topic/56202-make-selection-set-active/
;Original code asks for user to select objects to wblock out
;---------------------------------------------------------------------------------------------------
;Following code has been updated by Justin Ralston (JR) to select just visible objects
;in modelspace by switching to modelspace, zooming to extents and then doing a crossing window selection.
;The objects are then wblocked to a file in the same directory in a new folder called "wBlockedofModelspace"
;-----------------------------------------------------------------------------------------------------

;When using BatchinEditor type the following to have command run and switched to right filter
;(c:AL-WBLOCK_MODELSPACE) A
;((c:AL-WBLOCK_MODELSPACE) "A")x
;((c:-AL-WBLOCK_MODELSPACE) "A")x
;(c:AL-WBLOCK_MODELSPACE "A" "")x
(c:AL-WBLOCK_MODELSPACE" "" "A" "")x

;-----------------------------------Additional Code added by JR-----------------------------------
;select all objects in modelspace of the drawing

;Make sure the drawing is in modelspace
(setvar 'ctab "MODEL")

;Zoom to extents of modelspace to refresh the modelspace extents
(command "_.zoom" "_extents")

;Get the extents of modelspace
(Setq corner1 (getvar 'extmin)) ;Get the lower corner
(Setq corner2 (getvar 'extmax)) ;Get the upper corner

;Restore the drawing Zoom to previous state
(command "_.zoom" "_previous")

;---------------------------------Added by JR [if statement for user to choose filter]--------------------------------
(initget "AllinModel VisibleinModel NonC3DObjectsOnly C3DObjectsOnly")

(setq Kword (getkword "\nSelect Object Types to wblock [AllinModel/VisibleinModel/NonC3DObjectsOnly/C3DObjectsOnly] <AllinModel>: "))

(cond
((or (= kword nil)(= kword "AllinModel"))(Setq SelectTheseObjects (ssget "X" (list (cons 410 (getvar 'ctab))))) (prompt "\n You Selected AllinModel this selects everything in modelspace even if hidden and frozen plus C3d pipenetworks and site even if empty and does a wblock export"))
((= kword "VisibleinModel") (Setq SelectTheseObjects (ssget "_C" corner1 corner2 )) (prompt "\n You selected VisibleinModel this does a crossing window selection of only visible objects in modelspace and does a wblock export"))
((= kword "NonC3DObjectsOnly")(Setq SelectTheseObjects (ssget "_C" corner1 corner2 '((0 . "~AECC*")))) (prompt "\n You selected NonC3DObjectsOnly this does a crossing window selection of only visible objects in modelspace excluding civil3d objects and does a wblock export"))
((= kword "C3DObjectsOnly")(Setq SelectTheseObjects (ssget "_C" corner1 corner2 '((0 . "AECC*")))) (prompt "\n You selected C3DObjectsOnly this does a crossing window selection of all visible civil3d objects in modelspace only and does a wblock export"))
)

;Different ssget functions
;see http://www.lee-mac.com/ssget.html
;(ssget "_C" corner1 corner2 ) ; crossing window selection all objects
;(ssget "X" (list (cons 410 (getvar 'ctab)))) ;selects everything in modelspace even if hidden and frozen plus C3d pipenetworks and site even if empty

;Exclude all Civil3d Objects
;See https://forums.augi.com/showthread.php?172844-Lisp-code-to-wblock-all-objects-except-Civil-3D-object...
;(ssget "_C" corner1 corner2 '((0 . "~AECC*"))) ;crossing window selection all objects excluding civil3d

;Includes only Civil3d objects
;(ssget "_C" corner1 corner2 '((0 . "AECC*"))) ;crossing window selection all civil3d objects only

;---------------------------------Orginal Code by Lee Mac--------------------------------------------------

(if (setq sel SelectTheseObjects );Changed the ssget function here to select what you want to export
;---------------------------------Orginal Code Unchanged--------------------------------------------------
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
ssc (vla-get-selectionsets doc)
vsl (vla-add ssc (uniqueitem ssc "mywb"))
)
(vla-additems vsl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)

;-----------------------------------Added by JR-----------------------------------
;Add Create the name of the new file from the exisitng

;Get the existing file path
(Setq ExFilePath (getvar "dwgprefix"))

;Get the existing file name
(Setq ExFileName (getvar "dwgname"))

;Create a new folder for the wblock to be written out to.
(Setq NewFolderpath (strcat ExFilePath "wBlockedofModelspace"))
(vl-mkdir NewFolderpath) ; no error is thrown if it exists.

;Create a new file name for the wblock to write out to.
(Setq NewFilePathAndName (strcat NewFolderpath "//" ExFileName))
;(princ NewFilePathAndName)

;export the contents of just model space to a new drawing
;----------------------------------------------------------------------------------

;(vla-WBlock doc NewFilePathAndName vsl)

(vla-wblock doc

NewFilePathAndName

vsl
)

;(vla-wblock doc
; (vl-filename-mktemp
; (vl-filename-base (getvar 'dwgname)) ;Drawing Name strippped of path and extension
; (getvar 'dwgprefix) ;Drive and folderpath of current drawing
; ".dwg"
😉
;vsl
😉
(vla-delete vsl)
(prompt (strcat "\n Your new file has been written out to " NewFilePathAndName))
)
)
(princ)
)

(defun uniqueitem ( col key / int rtn )
(setq int 0)
(while
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item
(list col (setq rtn (strcat key (itoa (setq int (1+ int))))))
)
)
)
)
rtn
)

(vl-load-com) (princ)