Splitting up drawing into seperate files with LISP function?

[KLKSMILE]

;; 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)

(setq tOff 0.9428) ;

(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>"))

(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"))))

(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")))

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

(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]

I was trying a couple things and now it gives me this error:

 

Error: bad argument type: stringp 11

Command:

[KLKSMILE]

Here is the lsp file

DwgCut.LSP

[KLKSMILE]

ok - have no idea why - but it suddenly works again after re-starting cad for the 10th time today. WEIRD!

 

Sorry - thanks for your help!

[Lee Mac]

If in doubt, run a debug in the VLIDE in ACAD.

[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?

 

 

Now it is doing the same thing again...and I didn't change a thing!

 

I tried a billion things yesterday and I don't know what I did to get it to work....I rememeber reading some post somewhere (which I can't find now ) that cleared a value..???

 

Is there some setting that has to be on/off when runing the lisp?

 

Help Plez!

[Lee Mac]

Did you run a debug? If so, where is it crashing?

[KLKSMILE]

I now remember why...on the first sheet of all the drawings, the title of the sheet was actually an attribute. Even though it was on the titletext layer, it was not even running the lisp program because it was an attribute.

 

THanks!

[Lee Mac]

Glad you got it sorted in the end

[KLKSMILE]

OMG!

 

That apparently is not it...

 

I just ran a de-bug and the error ( which is now Error: bad argument type: stringp 9 ) happens at the following place the second time through the program:

 

(defun *error* (msg)

(if ovar (mapcar 'setvar vlst ovar))

(if (not (member msg '("Function cancelled" "quit / exit abort")))

(princ (strcat "\nError: " msg)) ***happend here**********

[Lee Mac]

That is just the Error handler function executing, comment out the Error Handler function and run to the debug to see where the error occurs - (prepare to reset your Osnaps though!)

[KLKSMILE]

It keeps looping and doen't stop here:

 

(if (and (eq "TitleText" (cdr (assoc 8 (entget ent))))

(member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT")))

(setq Nme (cdr (assoc 1 (entget ent))))))

[Lee Mac]

Theres no way it could loop indefinitely, its in a foreach loop, which will stop when it reaches the end of the list.

 

Perhaps set the debug delay down slightly, so that it wont take so long to iterate.

[KLKSMILE]

how do I do that?

[Lee Mac]

Tools > General Options > Diagnostic > Animation Delay

[KLKSMILE]

Am I supposed to be de-bugging in Visual Lisp? Beacuse I don't see thoes options

[Lee Mac]

Am I supposed to be de-bugging in Visual Lisp? Beacuse I don't see thoes options

 

Yes, sorry, I was referring to the Visual LISP Editor in ACAD.

[KLKSMILE]

ok - so I'm stumped-

 

I just had my co-worker try to run the lisp routine on one of his files and it worked. Then I had him try it on the file that I need to split up and the same bad argument type: stringp 11 error message happened. Then he tried to re-run his file that worked before and now that file doesn't work. What do you think is wrond with this file?

[KLKSMILE]

Can you try this file with the attached lisp routine?

test.dwg

DwgCut.LSP

[Lee Mac]

I haven't tried it yet, but in the mean time, I have fully annotated this LISP, so that you know what each part does.

 

I have also added an extra check:

 

;; 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 0.9428)   ; <<-- Adjust this if necessary

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

 (vl-load-com)

 ;; <<--  Error Handler  -->>

 (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))

 ;; <<--  Get Directory for New Files  -->>

 (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))

 ;; <<--  Collect all Borders in Drawing  -->>
 
 (if (setq ss (ssget "X" '((0 . "INSERT") (2 . "BORDER"))))
   (progn
     (foreach Obj  (mapcar 'vlax-ename->vla-object
                           (mapcar 'cadr (ssnamex ss)))

       ;; Get Border Window
       
       (vla-getBoundingBox Obj 'miPt 'maPt)
       (setq winLst (mapcar
                      (function
                        (lambda (x)
                          (vlax-safearray->list x))) (list miPt maPt)))
       
       (vla-ZoomExtents
         (vlax-get-acad-object))

       ;; Get All Objects within Border
       
       (setq iSs (ssget "_C" (car winLst) (cadr winLst)) i 2)

       ;; Check for Title Text
       
       (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))))))

       ;; In case Title Text is not found!
       (or Nme (setq Nme "Drawing1"))

       ;; Check for existing Drawings with the same name, and rename accordingly
       
       (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))  ;; Name(2).dwg

           ;; If Name(2).dwg also exists:
           
           (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))  ;; Name(3).. Name(4)..
                   i   (1+ i)))))

       ;; Create Full filepath:
       
       (setq fname (strcat path "\\" Nme ".dwg"))

       ;; Delete all Existing DateStamps:
       
       (if (setq dSs (ssget "X" '((0 . "*TEXT") (8 . "DATESTAMP"))))
         (mapcar 'entdel (mapcar 'cadr (ssnamex dSs))))

       ;; Add New DateStamp to Object Collection to be WBlocked:
               
       (ssadd
         (Make_Text
           (polar (car winLst) pi (- tOff 0.86))
             (DStamp Nme) (/ pi 2)) iSs)

       ;; Create VL Selection Set from iSs to be used in vla-Wblock method:
       
       (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)))

       ;; Invoke vla-wBlock:
       
       (vla-wBlock doc fname wBss)

       ;; Delete Selection Set ready for next border:
       
       (vla-delete (vla-item
                     (vla-get-SelectionSets doc) "wBss"))

       ;; Create Document list for use with Script
       
       (setq docLst (cons fname docLst)))

     ;; Create Script if required:
     
     (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))))

   ;; Else No Borders were Found
   
   (princ "\n<!> No Borders Found <!>"))
 (mapcar 'setvar vlst ovar)
 (princ))

;; Make Text Function ~ {for use with DateStamp}

(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))))

;; DateStamp Text Function

(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)