How could I make this lisp better?

CAD Forums > CAD General

(1/1)

ronjonp:
I put together many great routines I've found on forums (mostly from people here) to make one routine to clean up drawings and set a couple of variables. How does it look to you lisp gurus?

Thx

Ron :D

--- Code: ---(defun c:ninja (/ TXT NB NAMES BLK lay ent name removed cnt *acad* curdwg pslayout x)
(alert "Visretain is being set to 0")
(setvar 'visretain 0)
(setenv "MaxHatch" "10000000")
(command ".viewres" "y" "1000")
(command ".chprop" "all" "" "color" "bylayer"
"ltype" "bylayer" "ltscale" "1" "thickness"
"0" ""
)
(command ".vbastmt" "thisdrawing.purgeall" ".audit" "y")
(progn (textscr)
(princ "\n ***Viewres set to 1000***")
(princ "\n ***MaxHatch set to 10000000***")
(princ "\n ***All Objects Set to Color & Linetype Bylayer***")
(princ "\n ***Drawing Purged***")
(princ "\n ***Drawing Audited***")
(princ "\n ***All Layer Filters Deleted***")
(Princ "\n ***All Layer States Deleted***")
(Princ "\n ***All Registered Applications Deleted***")
(Princ "\n ***All Pagesetups Deleted***")
)

;_____________________________________________________________________________
;; DELETES ALL LAYER FILTERS
;_____________________________________________________________________________

(vl-Load-Com)
(vl-Catch-All-Apply
'(lambda ()
(vla-Remove
(vla-GetExtensionDictionary
(vla-Get-Layers
(vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
)
)
)
"ACAD_LAYERFILTERS"
)
)
)

;_____________________________________________________________________________
;; DELETES NUL LINES OF TEXT, MTEXT, AND BLOCKS
;_____________________________________________________________________________

(if (setq TXT (ssget "X"
'((-4 . "<and")
(-4 . "<or")
(0 . "MTEXT")
(0 . "TEXT")
(-4 . "or>")
(-4 . "<or")
(1 . "")
(1 . " ")
(1 . " ")
(1 . " ")
(1 . "{}")
(1 . "{ }")
(1 . "{ }")
(1 . "{ }")
(1 . "{}\P")
(1 . "{ }\P")
(1 . "{ }\P")
(1 . "{ }\P")
(-4 . "or>")
(-4 . "and>")
)
)
)
(progn
(command "_erase" TXT "")
(princ (strcat "\n "
(itoa (sslength TXT))
" nul text strings deleted. "
)
)
)
(princ "\n No nul text strings found. ")
)

(setq BLK (tblnext "BLOCK" T)
NAMES nil
)
(while BLK
(if (= (cdr (assoc 0 (entget (cdr (assoc -2 BLK))))) "ENDBLK")
(progn
(if (setq NB (ssget "X" (list (assoc 2 BLK))))
(command "_erase" NB "")
)
(setq NAMES (cons (cdr (assoc 2 BLK)) NAMES))
)
)
(setq BLK (tblnext "BLOCK"))
)
(if NAMES
(progn (textscr)
(princ "\n Nul blocks found and need purging: ")
(foreach X NAMES (princ "\n ") (princ X))
)
(princ "\n No nul blocks found. ")
)
(princ)
)

;_____________________________________________________________________________
;;CLEARS ALL LAYER STATES
;_____________________________________________________________________________

(
(lambda (/ lay ent)
(while (setq lay (tblnext "layer" (not lay)))
(if (and
(setq
ent (entget (tblobjname "layer" (cdr (assoc 2 lay)))
'("RAK")
)
)
(assoc -3 ent)
)
(entmod (subst '(-3 ("RAK")) (assoc -3 ent) ent))
)
)
)
)

;_____________________________________________________________________________
;;DELETES REGISTERED APPLICATIONS
;____________________________________________________________________________

(vl-load-com)
(setq cnt 0)
(if (not *acad*)(setq *acad* (vlax-get-acad-object)))
(vlax-for app (vla-get-registeredapplications (vla-get-activedocument *acad*))
(setq name (vla-get-name app))

(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-delete (list app))
)
)
(progn
(setq cnt (1+ cnt))
(setq removed
(princ
(strcat
"\nRemoved application \""
name
"\""
)
)
)
);end progn
)
)
(if (not removed)
(princ "\nNo applications were removable.")
(print cnt)
)
(princ)

;_____________________________________________________________________________
;;DELETES ALL PAGESETUPS
;_____________________________________________________________________________

(vl-load-com)
(setq
curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
) ;_ end of setq
;; Call RefreshPlotDeviceInfo before GetPlotDeviceNames
(vla-RefreshPlotDeviceInfo pslayout)
(vlax-for x (vla-get-Plotconfigurations curdwg)
(vla-delete x)
) ;_ end of vlax-for
(c:ninja)
--- End code ---

CAB:
That's a good start.

You might want to Zoom all layouts:

--- Code: ---(defun zoom_all_layouts (/ lay *doc*)
(vl-load-com)
(setq *acad* (vlax-get-acad-object)
*doc* (vla-get-activedocument *acad*)
layouts (vla-get-layouts *doc*)
)
(vlax-for lay layouts ; step through layouts
(vla-put-activelayout *doc* lay) ; activate layout
(if (= (vla-get-activespace *doc*) 0) ; If in paperspace
(if (= (vla-get-mspace *doc*) :vlax-true); in mspace viewport
(vla-put-mspace *doc* :vlax-false) ; inactivate vp
) ; endif
) ;endif
(vla-zoomextents *acad*)
)
)
(defun c:zal ()
(zoom_all_layouts)
)
--- End code ---

Or Lock all viewports:

--- Code: ---(defun c:vplockall () ; 4/26/01
(vl-load-com)
(vlax-for lay
(vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (eq :vlax-false (vla-get-modeltype lay))
(vlax-for ent (vla-get-block lay) ; for each ent in layout
(if (= (vla-get-objectname ent) "AcDbViewport")
(vla-put-displaylocked ent :vlax-true)
)
)
)
)

--- End code ---

Or reset system variables:

--- Code: ---;;; variable setting mechanism
;;; called from 'AlansAutoLoad.lsp'
;;;
;;; After setting the global variable, call the function, (vl-propagate
;;; 'globalVariable) where globalVariable is the symbol name of your global
;;; variable. This will copy the value of globalVariable into all open document
;;; namespaces and set its value in any subsequent drawings opened during the
;;; current AutoCAD session.

(defun set_vars_to_defaults (/ var)

(setq var (list
(list "angbase" 0 ) ;
(list "angdir" 0 ) ; CCW
(list "apbox" 0 ) ; Aperture box off 0
(list "aperture" 10 ) ; zone of detection
(list "aunits" 0 ) ; 0 = degrees 4 = survey
(list "auprec" 4 ) ; no od decimal places
(list "autosnap" 7 ) ;

(list "blipmode" 0 ) ; 0 = blips off

(list "chammode" 0 ) ; require 2 distances
(list "cmddia" 1 )
(list "cmdecho" 1 )
(list "coords" 1 )
(list "cursorsize" 5 ) ; size of cross

(list "dimaso" 1 ) ;
(list "dimsho" 1 )
(list "dragmode" 2 ) ; display outline
(list "dragp1" 10 )
(list "dragp2" 25 )

(list "edgemode" 1 ) ; trim to extension
(list "expert" 4 )

(list "facetres" 2 )
(list "filedia" 1 )
(list "filletrad" 0 )
(list "fillmode" 1 ) ;

(list "gridmode" 0 ) ; grid off
(list "grips" 1 ) ;
(list "gripsize" 3 ) ; grip box size

(list "highlight" 1 )

(list "insbase" (list 0 0 0)) ;
(list "isolines" 4 )

(list "limcheck" 0 ) ; 0= allow create obj outside limites
(list "lunits" 4 ) ; 4=Arch 2=decimal
(list "luprec" 5 ) ; decimal places displayed for linear

(list "maxactvp" 50 ) ; max viewport to be regenerated
(list "maxsort" 500) ; max num of layers to sort in layer manager
(list "mbuttonpan" 1) ;
(list "measurement" 0) ; English
(list "measureinit" 0) ; English
(list "mirrtext" 0 ) ; 1=mirror text 0=backwards test

(list "offsetgaptype" 0 ) ;
(list "osmode" 175 )

(list "pickadd" 1 )
(list "pickauto" 1 )
(list "pickbox" 3 ) ; the pick box size
(list "pickdrag" 0 )
(list "pickfirst" 1 )
(list "pickstyle" 1 ) ;
(list "plinegen" 0 ) ;
(list "plinetype" 2 ) ;
(list "plinewid" 0 ) ; pline width
(list "plotrotmode" 1) ; align lower left plot area with LL of paper
(list "polarmode" 1 ) ;
(list "projmode" 1 ) ;
(list "proxygraphics" 1) ;
(list "proxynotice" 1) ;
(list "proxyshow" 1) ;

(list "qtextmode" 0 ) ; 1=display box ILO text

(list "regenmode" 1 )

(list "savetime" 30 ) ; minutes between auto save 0=no auto save
(list "sdi" 0 )
(list "snapang" 0 )
(list "snapbase" (list 0 0)) ; hatch base point
(list "snapisopair" 0 )
(list "snapmode" 0 )
(list "snapstyl" 0 )
(list "snaptype" 0 )
(list "snapunit" (list 1 1))
(list "sortents" 96)
(list "splframe" 0 )

(list "textfill" 1 ) ; plot with text filled
(list "textqlty" 50 ) ; text resolution of TT font while plotting
(list "textsize" 5 ) ; default text size
(list "tooltips" 1 )
(list "trimmode" 1 )
(list "tstackalign" 1 )
(list "tstacksize" 70 )

(list "unitmode" 0 )
(list "ucsfollow" 0 )
(list "ucsicon" 0 ) ; 0=no display 3=display icon at origin

(list "worldview" 1 )

(list "visretain" 1 ) ; retain layer state

(list "zoomfactor" 10 )
)
); setq

(mapcar '(lambda (x)
(setvar(car x) (cadr x))
)
var)
(prompt "\nACADSet_Variables has set system variables to your preset values.")
(princ)

) ;; EOF
(set_vars_to_defaults)
--- End code ---

Or how about preferance settings:

--- Code: ---;|They're not sysvars but preference settings you can access with ActiveX
(VisualLISP). Here's a helper routine you can use to manipulate any
preference setting that can only be set to true or false. In your situation,
all the preferences you're looking for are in the Display preferences object
and they all require a regen to show the change, so here's what your calls
will look like. Hope this helps
|;

(defun limmax (value / AcadApp Doc Display Layout Margins Paper Shadow)
(if (/= (getvar "ctab") "Model")
(progn
(setq AcadApp (vlax-get-acad-object)
Doc (vla-get-ActiveDocument AcadApp)
Layout (vla-get-ActiveLayout Doc)
Display (vla-get-Display (vla-get-Preferences AcadApp))
Margins (vlax-get Display "LayoutDisplayMargins")
Paper (vlaX-get Display "LayoutDisplayPaper")
Shadow (vlaX-get Display "LayoutDisplayPaperShadow")
)
(vlax-put Display "LayoutDisplayMargins" 1)
(vlax-put Display "LayoutDisplayPaper" 1)
(vlax-put Display "LayoutDisplayPaperShadow" 1)
(redraw)
)
)
(if (and (listp value)(vl-remove-if-not 'numberp value))
(setvar "limmax" value)
)
(if Display
(progn
(vlax-put Display "LayoutDisplayMargins" Margins)
(vlax-put Display "LayoutDisplayPaper" Paper)
(vlax-put Display "LayoutDisplayPaperShadow" Shadow)
(redraw)
)
)
(getvar "limmax")
)
--- End code ---

ronjonp:
Thanks for the suggestions CAB :D

Ron

Navigation

[0] Message Index

Go to full version