Splitting up drawing into seperate files with LISP function?

[KLKSMILE]

oh - sorry - are you referring to the WBlocking comment? I didn't know what that ment.

[KLKSMILE]

I c - well then I think that's it! You Rock! Thank you so much!

[Lee Mac]

Oh, sorry, maybe I didn't explain it well enough:

 

When I output the drawings, I WBlock each border to the output file. But I can't access the output file to make changes on it (hence I can't zoom extents in the output file). Which is why I also had to insert the Date Tag in the main drawing before I Wblock'ed it.

[Lee Mac]

This will provide you with another option: a script is created which, if run, will save all the drawings with zoom extents.

 

;; Drawing Cutter V4, by Lee McDonnell 27.04.2009

(defun c:DwgCut  (/ *error* vlst ovar tOff doc file path ss dSs
                   miPt maPt winLst iSs i Nme fname
                   wBss wLst Scr sfile docLst)

 (setq tOff 1.6) ; <<-- Adjust this if necessary

 (setq Scr T) ; <<-- Write Script to Zoom Extents (T or nil)

 (vl-load-com)

 (defun *error*  (msg)
   (if ovar (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError: " msg))
     (princ "\n<<-- Function Cancelled -->>"))
   (princ))

 (setq vlst '("CLAYER" "OSMODE")
       ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)

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

 (or (tblsearch "LAYER" "DATESTAMP")
     (vla-put-color
       (vla-add
         (vla-get-Layers doc) "DATESTAMP") acYellow))

 (setq file (getfiled "Select Location for New Files" (if $def $def "") "dwg" 1))
 (if (not (setq $def file))
   (exit))
 (setq path (vl-filename-directory file))
 (if (setq ss (ssget "X" '((0 . "INSERT") (2 . "BORDER"))))
   (progn
     (foreach Obj  (mapcar 'vlax-ename->vla-object
                           (mapcar 'cadr (ssnamex ss)))
       (vla-getBoundingBox Obj 'miPt 'maPt)
       (setq winLst (mapcar
                      (function
                        (lambda (x) (vlax-safearray->list x)))
                          (list miPt maPt)))
       (vla-ZoomExtents
         (vlax-get-acad-object))
       (setq iSs (ssget "_C" (car winLst) (cadr winLst)) i 2)
       (foreach ent  (vl-remove-if 'listp
                       (mapcar 'cadr (ssnamex iSs)))
         (if (and (eq "TitleText" (cdr (assoc 8 (entget ent))))
                  (member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT")))
           (setq Nme (cdr (assoc 1 (entget ent))))))
       (if (member (strcat Nme ".dwg") (vl-directory-files path "*.dwg" 1))
         (progn
           (setq Nme (strcat Nme (chr 40) (itoa i) (chr 41)) i (1+ i))
           (while (member (strcat Nme ".dwg") (vl-directory-files path "*.dwg" 1))
             (setq Nme (strcat (substr Nme 1 (- (strlen Nme) 3)) (chr 40) (itoa i) (chr 41))
                   i   (1+ i)))))
       (setq fname (strcat path "\\" Nme ".dwg"))
       (if (setq dSs (ssget "X" '((0 . "*TEXT") (8 . "DATESTAMP"))))
         (mapcar 'entdel (mapcar 'cadr (ssnamex dSs))))
       (ssadd (Make_Text (polar (car winLst) pi (- tOff 0.86)) (DStamp Nme) (/ pi 2)) iSs)
       (setq wBss (vla-add (vla-get-SelectionSets doc) "wBss")
             wLst (mapcar 'vlax-ename->vla-object
                          (vl-remove-if 'listp
                            (mapcar 'cadr (ssnamex iSs)))))
       (vla-additems wBss (vlax-make-variant
                            (vlax-safearray-fill
                              (vlax-make-safearray
                                vlax-vbobject
                                (cons 0 (1- (length wLst)))) wLst)))
       (vla-wBlock doc fname wBss)
       (vla-delete (vla-item
                     (vla-get-SelectionSets doc) "wBss"))
       (setq docLst (cons fname docLst)))
     (if Scr
       (progn
         (setq sfile (open (strcat path "\\DwgCut.scr") "w"))
         (foreach dc  docLst
           (write-line (strcat "open \"" dc "\" zoom extents qsave close") sfile))
         (close sfile))))
   (princ "\n<!> No Borders Found <!>"))
 (mapcar 'setvar vlst ovar)
 (princ))

(defun Make_Text  (pt val rot)
 (entmakex (list '(0 . "TEXT")
                 (cons 8 "DATESTAMP")
                 (cons 10 pt)
                 (cons 40 (getvar "TEXTSIZE"))
                 (cons 1 val)
                 (cons 50 rot)
                 (cons 7 (getvar "TEXTSTYLE"))
                 '(71 . 0)
                 '(72 . 0)
                 '(73 . 1)
                 (cons 11 pt))))

(defun DStamp  (DNme / cAP cDate cMon cHrs cMin tStr)
 (setq cAP   "AM"
       cDate (rtos (getvar "CDATE") 2 4)
       cMon  (nth (1- (atoi (substr cDate 5 2)))
                  '("JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" "AUG" "SEP" "OCT" "NOV" "DEC"))
       cHrs  (atoi (substr cDate 10 2))
       cMin  (substr cDate 12 2))
 (cond ((<= 13 cHrs)
        (setq cAP  "PM" cHrs (itoa (- cHrs 12))))
       ((= 12 cHrs)
        (setq cAP  "PM" cHrs (itoa cHrs))))
 (setq tStr (strcat "DRFT: KLK FILE:" DNme "  DATE: " cMon
                    (chr 32) (substr cDate 7 2) ", " (substr cDate 1 4)
                    "  TIME: " cHrs (chr 58) cMin (chr 32) cAP))
 tStr)

[KLKSMILE]

HI!

 

It's been awhile...

 

SO I started noticing that the split up files are not inserted at the origin, this creats a problem when I need to re-edit the split up file. Is there a way to modify the lisp program to split up the drawings and insert each bottom left corner of the "BORDER" block at 0,0?

[Lee Mac]

The way my program functions, I think you would have to edit the new files - perhaps through the use of a script.

[KLKSMILE]

hmm...i c

So will I have to open each file and then run a script?

[KLKSMILE]

I really don't know much about writing script but I was wondering if this idea would work...

If I make a point on a specific layer at the bottom left corner of every BORDER block before I split it up, then can I open each file after it is split and somehow move everything on the page from the location of that point to the origin using a script???

 

Or is there a better way to do it?

[Lee Mac]

A script is very easy to make - don't worry.

 

The script works as if you were entering commands at the command line, and a space or new line is translated as the user hitting enter.

 

Hence you might want something like:

 

open "C:/Users/....dwg" move ... etc

 

Perhaps you could use a short LISP routine within the script to move the objects, something like this maybe, to move the basepoint of your border block to 0,0,0:

 

(defun mvObj (/ oldos ss blk bPt)
 (setq oldos (getvar "OSMODE"))
 (if (and (setq ss (ssget "_X"))
          (setq blk (ssget "_X" '((0 . "INSERT") (2 . "BORDER")))))
   (progn
     (setq bPt (cdr (assoc 10 (entget (ssname blk 0)))))
     (setvar "OSMODE" 0)
     (command "_.move" ss "" bPt '(0 0 0))))
 (setvar "OSMODE" oldos)
 (princ))

 

Then call it within the script:

 

open "C:/Users/...dwg" (mvObj) qsave close

 

Hope this helps,

 

Lee

 

If in doubt, just google AutoCAD scripts.

[KLKSMILE]

So I tried a bunch of differnt things but couldn't get this to work.

 

When I open one of the split files and click on the border block , the insert point is usually somewhere far away. I think this is why it isn't working?

 

Also, is there supposed to be a C: infront of mvObj in the LISP routine?

 

I attached one of the split files...do you think you could maybe try it?

HANSCF04.dwg

[Lee Mac]

When I open one of the split files and click on the border block , the insert point is usually somewhere far away. I think this is why it isn't working?

 

I see, perhaps we can do something with EXTMIN/MAX

 

 

Also, is there supposed to be a C: infront of mvObj in the LISP routine?

 

No, I defined it as a sub-function and called it as such

[Lee Mac]

Just curious, why are all your dimensions exploding?

[Lee Mac]

Perhaps include something like this in the script:

 

(defun mvObj (/ oldos ss bPt)
 (setq oldos (getvar "OSMODE") miP (getvar "EXTMIN"))
 (if (setq ss (ssget "_X"))
   (progn
     (setq bPt (polar miP 0 0.4))
     (setvar "OSMODE" 0)
     (command "_.move" ss "" bPt '(0 0 0))))
 (setvar "OSMODE" oldos)
 (princ))

[KLKSMILE]

Sweet - it worked!

Is there a way to then zoom extent each file, save it, and then close it?

 

Also, in the script file, can I run all the drawing files I want to do this to at once? Maybe by just putting the same script line with each different file name?

[KLKSMILE]

Just curious, why are all your dimensions exploding?

 

That is the way out drafting department does it...I get a lot of headaches from them.

[KLKSMILE]

oK - so I got the zoom extents, save, close to work.

Is there some way to enter everyfile into the script program so that I only have to run the program once?

[Lee Mac]

That is the way out drafting department does it...I get a lot of headaches from them.

 

Thats CRAZINESS! Why would they do that...??? That is the number 1 thing you SHOULDN'T do with dimensions!

 

oK - so I got the zoom extents, save, close to work.

Is there some way to enter everyfile into the script program so that I only have to run the program once?

 

Yes, just put the same thing on a new line

 

I'm guessing you have something like this:

 

open "C:/Users/test.dwg" (mvObj) zoom e qsave close
open "C:/Users/test2.dwg" (mvObj) zoom e qsave close

 

Or, you can even create a LISP program that will write a script for you I added that facility on the end of your last program.

[KLKSMILE]

So I have no idea why, but I can not run the dwgcut.lsp file now. I keep getting the following error message:

 

Command: DwgCut

Command:

Error: bad argument type: stringp 10

Command:

 

I even tried replacing the whole lisp file with one I sent to someone that I know worked. I think it has something to do with AutoCAD and not with the actual program. Any suggestions?

[KLKSMILE]

I have also tried running the file on several different dwgs - one's that I could split apart on Friday and now it gives me the above message.

[Lee Mac]

I would have to see the version you are using