Splitting up my drawings in multiple rectangles and saving these independently using LISP

[thomkevin94]

I want to split up my drawings and saving these independently.
 

I want this automated using a LISP. That would save me and my colleagues a lot of time.

I've been struggling with this because this is completely new for me. I've been looking online and read a lot of forums.

Also used some ChatGPT/Copilot, but I'm going from one error to the next.

 

I don't know what to do anymore, so now im here.

I have some code, but like I said I don't have the knowledge to tell if I'm doing the right thing.

 

What I got right now is this , files are saving in the right folder. But there is nothing within the borders. There is nothing of the drawing itself that's saved:

 

;; Drawing Cutter V4, by Lee McDonnell 27.04.2009

;; Updated  ~  (Lee Mac)  ~  21.04.10

(defun c:DwgCut (/ *error* BLST CENT DENT DOC DSS ENT
                   EXISTINGFILES FNAME ILST ISS LL N
                   NME OBJ PATH SPC SS TMP TOFF UR WBSS WINLST)

  (setq tOff 0.9428)
  
  (vl-load-com)

  (defun *error* (msg)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

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

        spc (GetActiveSpace doc))

  (vla-ZoomExtents acadd)
  
  (princ "\nZoom Extents completed.")
    
  (if (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "(TopografieGBKN) Sluitlijn"))))
           (setq path "DEPENDING ON PROJECT"))
    (progn
      (princ "\nPath set and selection set created.")
      (setq ExistingFiles (mapcar (function vl-filename-base)
                            (vl-directory-files path "*.dwg" 1)))
      
      ( (lambda ( i )        
          (while (setq ent (ssname ss (setq i (1+ i))))
            
            (vla-getBoundingBox
              (setq Obj (vlax-ename->vla-object ent)) 'll 'ur)

            (setq bLst (mapcar
                         (function
                           (lambda ( p ) (trans p 0 1)))

                         (mapcar (function vlax-safearray->list) (list ll ur))))

            ;; Get the coordinates of the lower-left corner
            (setq ll-coord (car bLst))
            (setq x-coord (rtos (car ll-coord) 2 0))
            (setq y-coord (substr (rtos (cadr ll-coord) 2 0) 1 4))

            ;; Generate the filename
            (setq Nme (strcat "g" x-coord y-coord))

            (setq tmp Nme n 1)
            (while (vl-position (strcase tmp) ExistingFiles)
              (setq tmp (strcat Nme "(" (itoa (setq n (1+ n))) ")")))
            
            (setq Nme tmp fname (strcat path "\\" Nme ".dwg"))

            ;; Add the polyline to the selection
            (setq iLst (list Obj))

            (vla-Additems (setq WBss (MakeSelectionSet doc "wBss"))
              (MakeVariant iLst vlax-vbobject))

            (vla-wBlock doc fname wBss)
            (vla-delete (Itemp (vla-get-SelectionSets doc) "wBss"))

            (setq ExistingFiles (cons (strcase Nme) ExistingFiles))))

        -1)))

  (princ "\nDWGCUT routine completed.")
  (princ))

(defun GetActiveSpace (doc)
  (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
          (eq :vlax-true (vla-get-MSpace doc)))
    (vla-get-ModelSpace doc)
    (vla-get-PaperSpace doc))
)

(defun MakeSelectionSet (doc ref / SelSets SelSet)
  (if (setq SelSet
        (Itemp
          (setq SelSets
            (vla-get-SelectionSets doc))
          ref))
    (vla-delete SelSet))
  (vla-add SelSets ref))

(defun MakeVariant (data datatype)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray (eval datatype)
        (cons 0 (1- (length data))))
      data)))

(defun Itemp (collection item / result)
  (if (not (vl-catch-all-error-p
             (setq result
                   (vl-catch-all-apply
                     (function vla-item) (list collection item)))))
    result))

 

Edited August 13 by SLW210
Added Code Tags! And original Header!!

[SLW210]

Please use Code Tags in the future. (<> in the Editor Toolbar).

 

Can you post a .dwg file? A before and after would be nice.

[SLW210]

That looks like a Lee Mac code with the header removed and it is incomplete as best as I can tell with a quick look.

 

 

;; Drawing Cutter V4, by Lee McDonnell 27.04.2009

;; Updated  ~  (Lee Mac)  ~  21.04.10

 

From this thread

[thomkevin94]

Thank you for the quick reply!

 

I will use the code tags in the future, didn't see that option.

 

And yes I got the base code from Lee mac on that topic. Header must have been removed by Chatgpt.

 

I added a test drawing with the borders. I put them over the drawing now manually. Eventually i would want to just have a grid overlay and that the LISP can figure out which rectangles have drawings in them and only save those, if that is possible.

 

I also added one of the saved files. I can add the rest, but they are also empty, just on different coördinates.

 

*No native English speaker by the way*

Revisie test.dwg g1949275756.dwg

[BIGAL]

Have a look at this.

 

The code makes layout for each rectang. No need for a seperate dwg. Also have walk along a pline.

 

 

Edited August 14 by BIGAL

[thomkevin94]

Hi BIGAL,

Thank you for your response! Unfortunately that's not really what I'm looking for.

I have to upload my drawings in a system we use. Unfortunately this system only accepts drawings made in predefined rectangles of 1000 wide and 500 high.

Every drawing is uploaded with a name corresponding with the coordinates.

For example:

- g1745600 (for coordinates 174000, 560000 from the lower left corner of the rectangle)

- g1745605 (for coordinates 174000, 560500 from the lower left corner of the rectangle)

- g1745610 (for coordinates 174000, 561000 from the lower left corner of the rectangle)

I don't really know what the easiest way is to do this. But I'd like to make these files automatically (with the right naming from the coordinates) from a big drawing. I dont't know if i should work with a predefined grid. That also means i'll get rectangles with no drawings in them though.

The main problem for now is that i can't figure out how to save the contents of said rectangle. I thought to tackle this one step at a time.

But like I said before, I really am a noob at this stuff.

All help is appreciated!

[Tsuky]

With your drawing, this seem to do the job.

(command "_.erase" (ssget "_X" '((0 . "LWPOLYLINE") (8 . "(TopografieGBKN) Sluitlijn"))) "")
(defun c:test ( / l_ext nb_x nb_y ss n dxf_ent l_pt ss_rec)
  (setvar "CMDECHO" 0)
  (command "_.zoom" "_extent")
  (setq
    l_ext (list (getvar "EXTMIN") (getvar "EXTMAX"))
    l_ext
    (mapcar
      '(lambda (x y)
        (list
          (* (fix (* x 0.001)) 1000)
          (* (fix (* y 0.002)) 500)
        )
      )
      (mapcar 'car l_ext)
      (mapcar 'cadr l_ext)
    )
    nb_x (1+ (/ (- (caadr l_ext) (caar l_ext)) 1000))
    nb_y (1+ (/ (- (cadadr l_ext) (cadar l_ext)) 500))
  )
  (setvar "CLAYER" "(TopografieGBKN) Sluitlijn")
  (command "_.rectang" "_none" (car l_ext) "_dim" 1000 500 "_none" (cadr l_ext))
  (command "_.array" (entlast) "" "_rectangular" nb_y nb_x 500 1000)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "(TopografieGBKN) Sluitlijn"))))
  (repeat (setq n (sslength ss))
    (setq
      dxf_ent (entget (ssname ss (setq n (1- n))))
      l_pt (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)
      ss_rec (ssget "_C" (cdar l_pt) (cdaddr l_pt) '((8 . "~(TopografieGBKN) Sluitlijn")))
    )
    (cond
      (ss_rec
        (command "_.undo" "_mark")
        (command "_.wblock"
          (strcat
            (getvar "DWGPREFIX")
            "g"
            (itoa (fix (* (cadar l_pt) 0.001)))
            (itoa (fix (* (caddar l_pt) 0.01)))
          )
          ""
          "*0,0,0"
          (ssadd (cdar dxf_ent) ss_rec)
          ""
        )
        (command "_.undo" "_back")
      )
      (T (entdel (cdar dxf_ent)))
    )
  )
  (setvar "CMDECHO" 1)
  (princ "\nQuit your drawing if you want keep it")
  (prin1)
)

 

Edited August 14 by Tsuky

[BIGAL]

1st comment the say lower left co-ordinate eg is X=194926.79  Y=575620.88  Z=0 for me this is a fail when placing 1st rectang it should be at a exact grid spacing X=194500 Y=575500. then its easy to place multi grids over the entire objects. So you provide the grid snap value even though pick a random point as guess. Yes have done this for world grid labelling. Yes use rectangles of 1000 wide and 500 high.

 

2nd step is remove any rectang that has nothing inside.

 

3rd step just use wblock to export all the rectangs to single dwg's.

 

Will see if can find time to do. 

 

Ps have a look at Wblock. Can select using WP and 4 corners.

[thomkevin94]

Thanks Tsuky,

That works! Great! Only I see that the saved files have the drawings in them where the drawing also goes outside of the border. Can it be cut off exactly at that border?

I uploaded one of the saved files to show.

BIGAL you are right with the coordinates, i was testing with the borders and wasn't even at the step yet for the right coordinates. I tested a lot with Wblock and learned a lot, but still couldn't really figure it out. From what I understand from your post you have an idea to select an area of the drawing which automatically makes the right borders?

Both of you many thanks for the help already.

g1955745.dwg

[Tsuky]

@thomkevin94

My solution which requires ExpressTools to be installed to be able to use the function (ETRIM ename pt_side)
So if the expresstools are available the modified code below should do the job.
NB: Perform the first two lines carefully before (defun c:test

(command "_.erase" (ssget "_X" '((0 . "LWPOLYLINE") (8 . "(TopografieGBKN) Sluitlijn"))) "")
(load "extrim.lsp")
(defun c:test ( / l_ext nb_x nb_y ss n dxf_ent l_pt ss_rec)
  (setvar "CMDECHO" 0)
  (command "_.zoom" "_extent")
  (setq
    l_ext (list (getvar "EXTMIN") (getvar "EXTMAX"))
    l_ext
    (mapcar
      '(lambda (x y)
        (list
          (* (fix (* x 0.001)) 1000)
          (* (fix (* y 0.002)) 500)
        )
      )
      (mapcar 'car l_ext)
      (mapcar 'cadr l_ext)
    )
    nb_x (1+ (/ (- (caadr l_ext) (caar l_ext)) 1000))
    nb_y (1+ (/ (- (cadadr l_ext) (cadar l_ext)) 500))
  )
  (setvar "CLAYER" "(TopografieGBKN) Sluitlijn")
  (command "_.rectang" "_none" (car l_ext) "_dim" 1000 500 "_none" (cadr l_ext))
  (command "_.array" (entlast) "" "_rectangular" nb_y nb_x 500 1000)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "(TopografieGBKN) Sluitlijn"))))
  (repeat (setq n (sslength ss))
    (setq
      dxf_ent (entget (ssname ss (setq n (1- n))))
      l_pt (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)
      ss_rec (ssget "_C" (cdar l_pt) (cdaddr l_pt) '((8 . "~(TopografieGBKN) Sluitlijn")))
    )
    (cond
      (ss_rec
        (command "_.undo" "_mark")
        (ETRIM (cdar dxf_ent) (polar (cdaddr l_pt) 0 1000))
        (command "_.wblock"
          (strcat
            (getvar "DWGPREFIX")
            "g"
            (itoa (fix (* (cadar l_pt) 0.001)))
            (itoa (fix (* (caddar l_pt) 0.01)))
          )
          ""
          "*0,0,0"
          (ssadd (cdar dxf_ent) ss_rec)
          ""
        )
        (command "_.undo" "_back")
      )
      (T (entdel (cdar dxf_ent)))
    )
  )
  (setvar "CMDECHO" 1)
  (princ "\nQuit your drawing if you want keep it")
  (prin1)
)

 

[thomkevin94]

Great, thank you so much! Took a quick look and seems that everything works. You saved us so much manual work.

I will test it, I'll let you know if i'll get stuck somewhere.

[BIGAL]

Tsuky had a go at code found (getvar "EXTMIN") can return an incorrect value if you say hide objects below the desired area extmin returns the value including all objects, possibly on layers frozen. Maybe my Bricscad. Oh I did find that you need to make sure snap is off.

So may still be better using.

(setq pt1 (getpoint "\nPick top left point ") pt2 (getcorner pt1 "\nPick bottom right"))

 

As I suggested previously then round down and up the corner points a given tolerance this gives 1st and last sheet a small tolerance say 50. Not sure why but the 1st rectang was not at the X value of extmin, tested on a random dwg. 

 

I use Bricscad V24 and had to redo the Command "rectang" just one of those subtle differences.

(command "_.rectang" "_dim" 1000 500 "_none" (car l_ext) "_none" (cadr l_ext))

 

Can see in this image outline is min & max the blue blocks are not in line with the rectang maybe need a -ve to rect corner for X.

Just a comment earlier versions of Bricscad need to have express tools downloaded. 

[BIGAL]

Just another way to make the rectangs, rounds down and up to 10 interval.

(command "snap" off)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq pt1 (getpoint "\nPick top left ")
pt2 (getcorner pt1 "\nPick bottom right ")
)

(setq x1 (car pt1) y1 (cadr pt1))
(setq x2 (car pt2) y2 (cadr pt2))
(setq x1 (- (* (fix (/ x1 10.0)) 10.0) 10.0))
(setq y1 (+ (* (fix (/ y1 10.0)) 10.0) 10.0))
(setq x2 (+ (* (fix (/ x2 10.0)) 10.0) 10.0))
(setq y2 (- (* (fix (/ y2 10.0)) 10.0) 10.0))

(setq pt1 (list x1 y1))
(setq pt2 (list x2 y2))

(setq d1 (fix (+ (/ (- (car pt2)(car pt1)) 1000.) 1)))
(setq d2 (fix (+ (/ (- (cadr pt1)(cadr pt2)) 500.) 1)))

(setvar "CLAYER" "(TopografieGBKN) Sluitlijn")

(command "_.rectang" pt1 (mapcar '+ pt1 (list 1000.0 -500.0 0.0)))

(command "_.array" (entlast) "" "_rectangular" "columns" d2 "rows" d1 -500 1000)

 

[thomkevin94]

Thank you for your comments. Just came back from a holiday (that's the reason for the delay) and just started testing again.

 

I use AutoCad and Tsuky's code seemes to work great most of the time. I have a few instances where it does go wrong.

I added the examples g1965745 and g1955750 where the polyline goes outside of the rectangle 'box'.

 

Any idea why this happens sometimes?

Revisie test.dwg g1965745.dwg g1955750.dwg