Jump to content

Cross Check


ksperopoulos

Recommended Posts

Like I have mentioned in my last few posts on here, I am new to the whole lisp thing. A lot of this stuff I am still trying to figure out what it is doing and/or means. So I was wondering if someone could look over a lisp routine I kind of piece-mealed together. I definitely didn't write this all by myself. This lisp is a cleaning procedure for our drawings that we receive from other contractors. It seems to work correctly, but you guys may have some good advice for a newbee like myself.

 

 
(defun c:scrubdwg (/ *error* uFlag)
    (vl-load-com)

    (defun *error* (msg)
    (and uFlag (vla-EndUndoMark *doc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
    (princ (strcat "\n** Error: " msg " **")))
    (princ))
    (setq *doc (cond (*doc)((vla-get-ActiveDocument
    (vlax-get-acad-object)))))
;;; Set UCS to world
    (command "setvar" "cmdecho" 0)(command "ucsfollow" "1")
    (command "setvar" "cmdecho" 0)(command "ucs" "w")
    (command "setvar" "cmdecho" 0)(command "ucsfollow" "0")
;;; Detach all xrefs
    (command "setvar" "cmdecho" 0)(command "-xref" "D" "*")
;;; Delete all layout tabs
    (vlax-for lay  (vla-get-layouts *doc)
    (if (not (eq "MODEL" (strcase (vla-get-Name lay))))
    (vla-delete lay)))
;;; Changes all layers to thaw, on, unlock, and .25mm lineweight. Set current layer to 0.
    (command "setvar" "cmdecho" 0)(command "-layer" "t" "*" "on" "*" "u" "*" "s" "0" "lw" "0.25" "*" "")
;;; Delete all layer filters
    (vl-catch-all-apply
    '(lambda ()
    (vla-remove
    (vla-getextensiondictionary
    (vla-get-layers
    (vla-get-activedocument (vlax-get-acad-object))
     ) ;_ end of vla-Get-Layers
     ) ;_ end of vla-GetExtensionDictionary
    "AcLyDictionary"
     ) ;_ end of vla-Remove
     ) ;_ end of lambda
     ) ;_ end of vl-Catch-All-Apply
;;; Delete all layer states
    (if (setq states (layerstate-getnames t t))
    (mapcar (function layerstate-delete) states))
;;; Delete all named views
    (command "setvar" "cmdecho" 0)(command "-view" "s" "junk")(command "-view" "d" "*")
;;; Set insertion basepoint to 0,0,0
    (command "setvar" "cmdecho" 0)(command "insbase" "0,0,0")
;;; Set overall, modelspace, and paperspace linetype scales to 1
    (command "setvar" "cmdecho" 0)(command "ltscale" 1)(command "msltscale" 1)(command "psltscale" 1)
;;; Set annotation scale to 1/4" = 1'-0"
    (command "setvar" "cmdecho" 0)(command "_CANNOSCALE" "1/4\042 = 1'-0\042")
;;; Delete unused scales
    (command "setvar" "cmdecho" 0)(command "-SCALELISTEDIT" "d" "*" "e")
;;; Erase x data
    (command "setvar" "cmdecho" 0)(command "erase" (ssget"x") "r")(princ))
;---------------------------------------------------------------------------------------------------------
(defun c:scrubdwg2 ()
;;; Set all object colors to bylayer
    (command "setvar" "cmdecho" 0)(command "setbylayermode" "1")
    (command "setvar" "cmdecho" 0)(command "setbylayer" "all" "" "y" "y")
;;; Delete all regapps
    (command "setvar" "cmdecho" 0)(command "-purge" "r" "" "n")
;;; Run an audit on the drawing file
    (command "setvar" "cmdecho" 0)(command "audit" "y")
;;; Purge all unused items
    (command "setvar" "cmdecho" 0)(command "-purge" "a" "*" "n")
;;; Zoom extents
    (command "setvar" "cmdecho" 0)(command "zoom" "e")(princ))

Link to comment
Share on other sites

Thank you for the advice. I assume since in this lisp I have two functions, I would have to set it once for each function (not commands) correct.

Link to comment
Share on other sites

eg.

 

(defun c:Test (/ p1 p2 cmd)
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify end point: "))
     )
   (progn
     (setq cmd (getvar 'cmdecho))
     (setvar 'cmdecho 0)
     (command "_.line" "_non" p1 "_non" p2 "")
     (setvar 'cmdecho cmd)
   )
 )
 (princ)
)

Link to comment
Share on other sites

Thank you for the advice. I assume since in this lisp I have two functions, I would have to set it once for each function (not commands) correct.

Set at beginning, and reset at end...

 

eg. (2)...

 

(defun c:Test (/ _fnc p1 p2 cmd)
 (defun _fnc (/) (alert "Hey look, I'm a separate function!"))
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify end point: "))
     )
   (progn
     (setq cmd (getvar 'cmdecho))
     (setvar 'cmdecho 0)
     (_fnc)
     (command "_.line" "_non" p1 "_non" p2 "")
     (_fnc)
     (setvar 'cmdecho cmd)
   )
 )
 (princ)
)

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