Splitting up drawing into seperate files with LISP function?

[Lee Mac]

That drawing works fine for me

[KLKSMILE]

AHHH!!

 

It doesn't for me!!! :'(

[Lee Mac]

AHHH!!

 

It doesn't for me!!! :'(

 

Are you trying the one I just posted?

 

Is it the same error as before?

[KLKSMILE]

Yes - the same error

 

 

Command:

Error: bad argument type: stringp 11

[Lee Mac]

I'm at a loss - It all works for me, so I can't determine where the error is to fix it.

 

Did you find out where it crashes in the debug? That would be a great help

[Lee Mac]

Perhaps its in the DStamp function?

 

Try this,

 

Load the program, but don't run it, then, at the command line, type this:

 

(dStamp "test")

[KLKSMILE]

So I did what u said above and also changed the annimation delay from 500 to 2. I also added a bunch of breakpoints in the code.

 

When I enter the code above it instantly returns the line:

 

_2$ (dStamp "test")

; error: bad argument type: stringp 11

_3$

[Lee Mac]

So I did what u said above and also changed the annimation delay from 500 to 2. I also added a bunch of breakpoints in the code.

 

When I enter the code above it instantly returns the line:

 

_2$ (dStamp "test")

; error: bad argument type: stringp 11

_3$

 

Bingo - there is our problem!

 

Something within the DStamp function

[Lee Mac]

I can't see what though, as DStamp returns this on my computer:

 

_$ (dstamp "test")
"DRFT: KLK FILE:test  DATE: AUG 20, 2009  TIME: 5:19 PM"

[KLKSMILE]

I don't understand what the issue is with that function...

well here's a thought - if you took out the whole date tag line and I just add the tag lisp that I have on my computer to the script routine that run after the program breaks up the file then it might work

[Lee Mac]

AHahahahhahaah

 

You are never going to believe what it was!!

[Lee Mac]

Ok, so, in the DateStamp function we check whether the hours are past 13, or equal to 12, then convert to a string.

 

But, we didn't convert it if the Hours are before 12... and, of course, I have only been testing it in the afternoon!

 

This should work now:

 

;; 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)))
       (t (setq 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]

it is the time change??

cuz it now works!!!

[KLKSMILE]

Awesome - that's great!!!! and kinda funny!!!!!

[Lee Mac]

it is the time change??

cuz it now works!!!

 

Its just that you were testing it when the CDATE hours reading was before 12, and the code hadn't accounted for that... schoolboy error!

 

Glad it works now though!

 

Lee

[KLKSMILE]

Thanks Lee so much! You are awesome!!!

[Lee Mac]

Thanks Lee so much! You are awesome!!!

 

happy to help

 

Btw, If you need the script option amended at the end, just let me know

[Biscuits]

Hi gang!

I've been lurking in the background watching this post develope. This is a sweet routine. I was wondring if this could be modified to move the titleblocks to layout tabs within the same file? Moving page 1 (named view 1) to layout tab 01, etc. instead of separate drawing files.

 

Thanks

[Lee Mac]

Would you want the Titleblock moved and then a viewport created? Or would it be everything inside the titleblock also move to PaperSpace?

[Biscuits]

Would you want the Titleblock moved and then a viewport created? Or would it be everything inside the titleblock also move to PaperSpace?

No viewports used. Everything inside the titleblock is to be moved to PaperSpace. Thanks