Automatic Line Creation Based on Selected Blocks

[Tamim]

Hi Friends,

 

I have attached a sample document for reference. I need assistance in creating a function or tool that automatically generates lines based on the blocks I select.Thank you for your help.

Sample02.dwg

[marko_ribar]

;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/connect-selected-blocks-with-the-smallest-polyline-length/m-p/8419663#M377509 ;;;

(defun c:shortpath-blks ( / mid car-sort online ss i blks ll ur plst p pp rtn )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst func / itm rtn )
    (setq itm (car lst))
    (foreach a (cdr lst)
      (if (apply func (list a itm))
        (setq itm a rtn a)
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq blks (cons (ssname ss (setq i (1- i))) blks))
    )
  )
  (foreach blk blks
    (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur))
    (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
    (setq plst (cons (mid ll ur) plst))
  )
  (setq p (car-sort plst (function (lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
  (setq rtn (cons p rtn))
  (while plst
    (setq plst (vl-remove p plst))
    (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
      (progn
        (setq rtn (cons pp rtn))
        (setq p pp)
      )
      (progn
        (if plst
          (setq rtn (cons (car plst) rtn))
        )
        (setq plst nil)
      )
    )
  )
  (setq rtn (reverse rtn))
  (setq p (car rtn))
  (foreach pp (cdr rtn)
    (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
      (progn
        (setq p pp)
        (setq rtn (vl-remove pp rtn))
      )
      (setq p pp)
    )
  )
  (vl-cmdf "_.pline")
  (foreach p rtn
    (vl-cmdf "_non" p)
  )
  (vl-cmdf "")
  (princ)
)

 

HTH.

M.R.

Edited January 24 by marko_ribar

[Tamim]

11 hours ago, marko_ribar said:

;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/connect-selected-blocks-with-the-smallest-polyline-length/m-p/8419663#M377509 ;;;

(defun c:shortpath-blks ( / mid car-sort online ss i blks ll ur plst p pp rtn )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst func / itm rtn )
    (setq itm (car lst))
    (foreach a (cdr lst)
      (if (apply func (list a itm))
        (setq itm a rtn a)
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq blks (cons (ssname ss (setq i (1- i))) blks))
    )
  )
  (foreach blk blks
    (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur))
    (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
    (setq plst (cons (mid ll ur) plst))
  )
  (setq p (car-sort plst (function (lambda ( a b ) (if (= (car a) (car b)) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
  (setq rtn (cons p rtn))
  (while plst
    (setq plst (vl-remove p plst))
    (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
      (progn
        (setq rtn (cons pp rtn))
        (setq p pp)
      )
      (progn
        (if plst
          (setq rtn (cons (car plst) rtn))
        )
        (setq plst nil)
      )
    )
  )
  (setq rtn (reverse rtn))
  (setq p (car rtn))
  (foreach pp (cdr rtn)
    (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
      (progn
        (setq p pp)
        (setq rtn (vl-remove pp rtn))
      )
      (setq p pp)
    )
  )
  (vl-cmdf "_.pline")
  (foreach p rtn
    (vl-cmdf "_non" p)
  )
  (vl-cmdf "")
  (princ)
)

 

HTH.

M.R.

 

HI M.R

Thanks for the program. It's worked. Below, I have attached one more sample: the number of blocks is more than 600. If I select all the blocks, the line creates 18 or 17 blocks in a straight line. It's possible. The sample CAD file I have attached; please advise. 

 

Sample-2.dwg

[Emmanuel Delay]

That second sample drawing has overlapping blocks.

It messes up the algorithm

[SR211]

It automatically generates lines based on the selected blocks. If possible, please help me it would be very helpful for me

[GLAVCVS]

27 minutes ago, SR211 said:

Genera lineas automaticamente en base a los bloques seleccionados. Si es posible por favor ayudame seria de mucha ayuda para mi

 

Will the blocks always have these green components somewhere?

In any case, you should attach an example drawing

 

 

[SR211]

i attach an example drawing pls check

B4-EF-1070 LOWER ROOF FLOOR FIRE DETECTION & ALARM LAYOUT.dwg

[Tamim]

1 hour ago, Emmanuel Delay said:

That second sample drawing has overlapping blocks.

It messes up the algorithm

I've attached the correct CAD file. Could you please review and advise on this one?

Sample-2.dwg

[marko_ribar]

(defun c:lwlines-blks ( / mid car-sort online ss i blks ll ur plst p pp ppp sppp mp rtn k li li1 li2 )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst func / itm rtn )
    (setq itm (car lst))
    (foreach a (cdr lst)
      (if (apply func (list a itm))
        (setq itm a rtn a)
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq blks (cons (ssname ss (setq i (1- i))) blks))
    )
  )
  (foreach blk blks
    (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur))
    (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
    (setq plst (cons (mid ll ur) plst))
  )
  (setq p (car-sort plst (function (lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
  (setq rtn (cons p rtn))
  (while plst
    (setq plst (vl-remove p plst))
    (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
      (progn
        (setq rtn (cons pp rtn))
        (setq p pp)
      )
      (progn
        (if plst
          (setq rtn (cons (car plst) rtn))
        )
        (setq plst nil)
      )
    )
  )
  (setq rtn (reverse rtn))
  (setq ppp rtn)
  (setq p (car rtn))
  (foreach pp (cdr rtn)
    (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
      (progn
        (setq p pp)
        (setq rtn (vl-remove pp rtn))
      )
      (setq p pp)
    )
  )
  (setq k 1)
  (while rtn
    (setq k (1+ k))
    (if (= 0 (rem k 2))
      (setq li (list (car rtn) (cadr rtn)))
      (setq li (list (cadr rtn) (car rtn)))
    )
    (setq mp (mid (car rtn) (cadr rtn)))
    (setq sppp (vl-sort ppp (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
    (setq sppp (list (car sppp) (cadr sppp)))
    (setq li1 (list (car li) (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b)))))))
    (setq li2 (list (car-sort sppp (function (lambda ( a b ) (< (distance (cadr li) a) (distance (cadr li) b))))) (cadr li)))
    (setq rtn (cddr rtn))
    (vl-cmdf "_.pline")
    (foreach p li1
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
    (vl-cmdf "_.pline")
    (foreach p li2
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )
  (princ)
)

 

HTH.

M.R.

Edited January 24 by marko_ribar

[Tamim]

1 hour ago, marko_ribar said:

(defun c:lwlines-blks ( / mid car-sort online ss i blks ll ur plst p pp ppp sppp mp rtn k li li1 li2 )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst func / itm rtn )
    (setq itm (car lst))
    (foreach a (cdr lst)
      (if (apply func (list a itm))
        (setq itm a rtn a)
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq blks (cons (ssname ss (setq i (1- i))) blks))
    )
  )
  (foreach blk blks
    (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur))
    (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
    (setq plst (cons (mid ll ur) plst))
  )
  (setq p (car-sort plst (function (lambda ( a b ) (if (= (car a) (car b)) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
  (setq rtn (cons p rtn))
  (while plst
    (setq plst (vl-remove p plst))
    (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
      (progn
        (setq rtn (cons pp rtn))
        (setq p pp)
      )
      (progn
        (if plst
          (setq rtn (cons (car plst) rtn))
        )
        (setq plst nil)
      )
    )
  )
  (setq rtn (reverse rtn))
  (setq ppp rtn)
  (setq p (car rtn))
  (foreach pp (cdr rtn)
    (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
      (progn
        (setq p pp)
        (setq rtn (vl-remove pp rtn))
      )
      (setq p pp)
    )
  )
  (setq k 1)
  (while rtn
    (setq k (1+ k))
    (if (= 0 (rem k 2))
      (setq li (list (car rtn) (cadr rtn)))
      (setq li (list (cadr rtn) (car rtn)))
    )
    (setq mp (mid (car rtn) (cadr rtn)))
    (setq sppp (vl-sort ppp (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
    (setq sppp (list (car sppp) (cadr sppp)))
    (setq li1 (list (car li) (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b)))))))
    (setq li2 (list (car-sort sppp (function (lambda ( a b ) (< (distance (cadr li) a) (distance (cadr li) b))))) (cadr li)))
    (setq rtn (cddr rtn))
    (vl-cmdf "_.pline")
    (foreach p li1
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
    (vl-cmdf "_.pline")
    (foreach p li2
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )
  (princ)
)

 

HTH.

M.R.

HI M.R

 

I’m not a Lisp programmer, but from my understanding, your midpoint function method uses a line to create and close the midpoint. The algorithm seems to work well, but in some random cases, there’s an issue. For the first row, first column, with 40 blocks, and the second row, second column, also with 40 blocks, the lines are created as follows:

From the first row to the 18th column block, and from the 1st row, 19th column, 36 blocks are created.

The same pattern applies for the second row and second column.

However, for rows 37 to 40, no creat line  .need want  like concept 

[marko_ribar]

I don't understand...

Please, provide *.DWG in which you explain what's wrong and what should routine do...

[Tamim]

10 hours ago, marko_ribar said:

I don't understand...

Please, provide *.DWG in which you explain what's wrong and what should routine do...

i upload a CAD file pls help 

Sample-r2.dwg

[marko_ribar]

I don't see a problem... You select 36 blocks instead of 40 and it draws lines like you explained as desired (first 18 from left to right and second 18 also from left to right - just in continuation from first)... Then if you select 40 it draws 2 lines - (first 20 from left to right and second 20 also from left to right - just in continuation from first)...

[Tamim]

28 minutes ago, marko_ribar said:

I don't see a problem... You select 36 blocks instead of 40 and it draws lines like you explained as desired (first 18 from left to right and second 18 also from left to right - just in continuation from first)... Then if you select 40 it draws 2 lines - (first 20 from left to right and second 20 also from left to right - just in continuation from first)...

My friend's code is not the issue. The working area has more than 1000 blocks available for every project. My query is: when selecting (for example, 1000 blocks at once), can a line be drawn only for 18 blocks at a time, and skip drawing a line at the end of each block ,Is something like that possible?

[marko_ribar]

3 hours ago, Tamim said:

My friend's code is not the issue. The working area has more than 1000 blocks available for every project. My query is: when selecting (for example, 1000 blocks at once), can a line be drawn only for 18 blocks at a time, and skip drawing a line at the end of each block ,Is something like that possible?

 

I don't see why is for you the problem in selecting 36 blocks per row until all 1000 blocks are selected and then let routine finish the job... If I understood correctly you have 40 blocks per row and you want each row to be processed with 36 blocks... Is that correct?

[Tamim]

1 hour ago, marko_ribar said:

 

I don't see why is for you the problem in selecting 36 blocks per row until all 1000 blocks are selected and then let routine finish the job... If I understood correctly you have 40 blocks per row and you want each row to be processed with 36 blocks... Is that correct?

Yes, you understood correctly

[marko_ribar]

Here, try this revision...

 

(defun c:lwlines-blks ( / mid car-sort online ch ss i blks ll ur plst p pp ppp sppp mp rtn k x n r li li1 li2 )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst func / itm rtn )
    (setq itm (car lst))
    (foreach a (cdr lst)
      (if (apply func (list a itm))
        (setq itm a rtn a)
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (initget 1 "Left Right")
  (setq ch (getkword "\nChoose side from where to trim 4 pieces of blocks [Left / Right] : "))
  (initget 7)
  (setq n (getint "\nSpecify how many blocks you want to skip per each row : "))
  (initget 7)
  (setq r (getint "\nSpecify how many blocks are in each row : "))
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq blks (cons (ssname ss (setq i (1- i))) blks))
    )
  )
  (foreach blk blks
    (vla-getboundingbox (vlax-ename->vla-object blk) (quote ll) (quote ur))
    (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
    (setq plst (cons (mid ll ur) plst))
  )
  (setq p (car-sort plst (function (lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
  (setq rtn (cons p rtn))
  (while plst
    (setq plst (vl-remove p plst))
    (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
      (progn
        (setq rtn (cons pp rtn))
        (setq p pp)
      )
      (progn
        (if plst
          (setq rtn (cons (car plst) rtn))
        )
        (setq plst nil)
      )
    )
  )
  (setq rtn (reverse rtn))
  (if (= ch "Left")
    (setq rtn (vl-remove-if (function (lambda ( p ) (< (car p) (if (not x) (setq x (car (nth n rtn))) x)))) rtn))
  )
  (if (= ch "Right")
    (setq rtn (vl-remove-if (function (lambda ( p ) (> (car p) (if (not x) (setq x (car (nth (- r n 1) rtn))) x)))) rtn))
  )
  (setq ppp rtn)
  (setq p (car rtn))
  (foreach pp (cdr rtn)
    (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
      (progn
        (setq p pp)
        (setq rtn (vl-remove pp rtn))
      )
      (setq p pp)
    )
  )
  (setq k 1)
  (while rtn
    (setq k (1+ k))
    (if (= 0 (rem k 2))
      (setq li (list (car rtn) (cadr rtn)))
      (setq li (list (cadr rtn) (car rtn)))
    )
    (setq mp (mid (car rtn) (cadr rtn)))
    (setq sppp (vl-sort ppp (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
    (setq sppp (list (car sppp) (cadr sppp)))
    (setq li1 (list (car li) (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b)))))))
    (setq li2 (list (car-sort sppp (function (lambda ( a b ) (< (distance (cadr li) a) (distance (cadr li) b))))) (cadr li)))
    (setq rtn (cddr rtn))
    (vl-cmdf "_.pline")
    (foreach p li1
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
    (vl-cmdf "_.pline")
    (foreach p li2
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )
  (princ)
)

HTH.

Regards, M.R.

[Tamim]

Thanks Mr M.R

 

[marko_ribar]

@Tamim

Hi... I've improved my code to work well in any UCS aligned to grid dispositioned blocks and further more added versions for coulmns beside already posted versions for rows...

This is my FINAL version and I hope it will help you...

(defun c:grid-blks ( / *error* chh ch1 ch2 mid car-sort online nextpt UCS2WCSMatrix WCS2UCSMatrix ucs-bbox lines-rowsX lines-columnsX path-rowsX path-columnsX lines-rowsY lines-columnsY path-rowsY path-columnsY cmd  )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.undo" "_e")
        (vl-cmdf "_.undo" "_e")
      )
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (alert "If disposition of middles of bounding boxes of grid blocks, other entities or points are equal in X and Y directions, then if you want to make lines or paths by rows, you should choose X size larger than Y, and opposite if you want them by columns, you should choose Y size larger than X...")

  (initget 1 "X Y")
  (setq chh (getkword "\nChoose which side of blocks, other entities or points is larger looking from active UCS [X / Y] : "))
  (initget 1 "Lines Path")
  (setq ch1 (getkword "\nChoose an option [Lines / Path] : "))
  (initget 1 "Rows Columns")
  (setq ch2 (getkword "\nChoose an option [Rows / Columns] : "))
  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (vl-cmdf "_.undo" "_e")
  )
  (vl-cmdf "_.undo" "_g")

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (defun car-sort ( lst fun / r )
    (setq r (car lst))
    (foreach itm (cdr lst)
      (if (apply fun (list itm r))
        (setq r itm)
      )
    )
    r
  )

  (defun online ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (defun nextpt ( p lst d / rtn )
    (foreach itm (vl-remove p (reverse lst))
      (if (equal (distance p itm) d 1e-6)
        (setq rtn itm)
        (if (< (distance p itm) d)
          (setq rtn itm)
        )
      )
    )
    rtn
  )

  ;; Doug C. Broad, Jr.
  ;; can be used with vla-transformby to
  ;; transform objects from the UCS to the WCS
  (defun UCS2WCSMatrix nil
    (vlax-tmatrix
      (append
        (mapcar
          (function 
            (lambda ( vector origin )
              (append (trans vector 1 0 t) (list origin))
            )
          )
          (list (list 1.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 0.0 1.0))
          (trans (list 0.0 0.0 0.0) 0 1)
        )
        (list (list 0.0 0.0 0.0 1.0))
      )
    )
  )
  ;; transform objects from the WCS to the UCS
  (defun WCS2UCSMatrix nil
    (vlax-tmatrix
      (append
        (mapcar
          (function
            (lambda ( vector origin )
              (append (trans vector 0 1 t) (list origin))
            )
          )
          (list (list 1.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 0.0 1.0))
          (trans (list 0.0 0.0 0.0) 1 0)
        )
        (list (list 0.0 0.0 0.0 1.0))
      )
    )
  )

  ;; UCS-BBOX (gile)
  ;; Returns the UCS coordinates of the object bounding box about UCS
  ;;
  ;; Argument
  ;;  obj : a graphical object (ename or vla-object)
  ;;
  ;; Return
  ;; a list of left lower point and right upper point UCS coordinates

  (defun ucs-bbox ( obj / minpoint maxpoint )
    (and (= (type obj) (quote ename))
      (setq obj (vlax-ename->vla-object obj))
    )
    (vla-TransformBy obj (UCS2WCSMatrix))
    (vla-getboundingbox obj (quote minpoint) (quote maxpoint))
    (vla-TransformBy obj (WCS2UCSMatrix))
    (list
      (safearray-value minpoint)
      (safearray-value maxpoint)
    )
  )

  (defun lines-columnsX ( / cm ss i blkx blks bb ll ur plst p pp ppp sppp mp rtn k li li1 li2 ch nn n1 n2 c x y )
    (initget 1 "Yes No")
    (setq cm (getkword "\nMiddle separation [Yes / No] : "))
    (initget 1 "Down Up Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Down / Up / Both / None] : "))
    (if (or (= ch "Down") (= ch "Up"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each column : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Down side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Up side : "))
      )
    )
    (initget 7)
    (setq c (getint "\nSpecify how many blocks, other entities or points are in each column : "))
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car-sort plst (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Down")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth nn rtn))) x)))) rtn))
        (setq c (- c nn))
      )
      ( (= ch "Up")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not x) (setq x (cadr (nth (- c nn 1) rtn))) x)))) rtn))
        (setq c (- c nn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not y) (setq y (cadr (nth (- c n1 n2 1) rtn))) y)))) rtn))
        (setq c (- c n1 n2))
      )
    )
    (setq ppp rtn)
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq k 1)
    (while rtn
      (setq k (1+ k))
      (if (= 0 (rem k 2))
        (setq li (list (car rtn) (cadr rtn)) mp (mapcar (function +) (list 0.0 1e-3 0.0) (mid (car rtn) (cadr rtn))))
        (setq li (list (cadr rtn) (car rtn)) mp (mapcar (function +) (list 0.0 -1e-3 0.0) (mid (cadr rtn) (car rtn))))
      )
      (if (= (rem c 2) 0)
        (setq mp (mid (car rtn) (cadr rtn)))
      )
      (setq sppp (vl-sort (vl-remove-if-not (function (lambda ( p ) (equal (car p) (caar rtn) 1e-6))) ppp) (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
      (setq sppp (list (car sppp) (cadr sppp)))
      (setq li1 (list (car li) (setq x (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b))))))))
      (setq li2 (list (car (vl-remove x sppp)) (cadr li)))
      (setq li1 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li1))
      (setq li2 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li2))
      (setq rtn (cddr rtn))
      (if (= cm "Yes")
        (progn
          (vl-cmdf "_.pline")
          (foreach p li1
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
          (vl-cmdf "_.pline")
          (foreach p li2
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
        )
        (vl-cmdf "_.pline" "_non" (car li1) "_non" (cadr li2) "")
      )
    )
  )

  (defun lines-rowsX ( / cm ss i blkx blks bb ll ur plst p d pp ppp sppp mp rtn k li li1 li2 ch nn n1 n2 r x y )
    (initget 1 "Yes No")
    (setq cm (getkword "\nMiddle separation [Yes / No] : "))
    (initget 1 "Left Right Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Left / Right / Both / None] : "))
    (if (or (= ch "Left") (= ch "Right"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each row : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Left side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Right side : "))
      )
    )
    (initget 7)
    (setq r (getint "\nSpecify how many blocks, other entities or points are in each row : "))
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car (setq plst (vl-sort plst (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (< (car a) (car b)) (< (cadr a) (cadr b)))))))))
    (setq d (distance p (cadr plst)))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (nextpt p plst d))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Left")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth nn rtn))) x)))) rtn))
        (setq r (- r nn))
      )
      ( (= ch "Right")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not x) (setq x (car (nth (- r nn 1) rtn))) x)))) rtn))
        (setq r (- r nn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not y) (setq y (car (nth (- r n1 n2 1) rtn))) y)))) rtn))
        (setq r (- r n1 n2))
      )
    )
    (setq ppp rtn)
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq k 1)
    (while rtn
      (setq k (1+ k))
      (if (= 0 (rem k 2))
        (setq li (list (car rtn) (cadr rtn)) mp (mapcar (function +) (list 1e-3 0.0 0.0) (mid (car rtn) (cadr rtn))))
        (setq li (list (cadr rtn) (car rtn)) mp (mapcar (function +) (list -1e-3 0.0 0.0) (mid (cadr rtn) (car rtn))))
      )
      (if (= 0 (rem r 2))
        (setq mp (mid (car rtn) (cadr rtn)))
      )
      (setq sppp (vl-sort (vl-remove-if-not (function (lambda ( p ) (equal (cadr p) (cadar rtn) 1e-6))) ppp) (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
      (setq sppp (list (car sppp) (cadr sppp)))
      (setq li1 (list (car li) (setq x (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b))))))))
      (setq li2 (list (car (vl-remove x sppp)) (cadr li)))
      (setq li1 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li1))
      (setq li2 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li2))
      (setq rtn (cddr rtn))
      (if (= cm "Yes")
        (progn
          (vl-cmdf "_.pline")
          (foreach p li1
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
          (vl-cmdf "_.pline")
          (foreach p li2
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
        )
        (vl-cmdf "_.pline" "_non" (car li1) "_non" (cadr li2) "")
      )
    )
  )

  (defun path-columnsX ( / ss i blkx blks bb ll ur plst p pp rtn ch nn n1 n2 c x y )
    (initget 1 "Down Up Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Down / Up / Both / None] : "))
    (if (or (= ch "Down") (= ch "Up"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each column : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Down side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Up side : "))
      )
    )
    (if (/= ch "None")
      (progn
        (initget 7)
        (setq c (getint "\nSpecify how many blocks, other entities or points are in each column : "))
      )
    )
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car-sort plst (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Down")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth nn rtn))) x)))) rtn))
      )
      ( (= ch "Up")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not x) (setq x (cadr (nth (- c nn 1) rtn))) x)))) rtn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not y) (setq y (cadr (nth (- c n1 n2 1) rtn))) y)))) rtn))
      )
    )
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq rtn (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) rtn))
    (vl-cmdf "_.pline")
    (foreach p rtn
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )

  (defun path-rowsX ( / ss i blkx blks bb ll ur plst p d pp rtn ch nn n1 n2 r x y )
    (initget 1 "Left Right Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Left / Right / Both / None] : "))
    (if (or (= ch "Left") (= ch "Right"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each row : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Left side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Right side : "))
      )
    )
    (if (/= ch "None")
      (progn
        (initget 7)
        (setq r (getint "\nSpecify how many blocks, other entities or points are in each row : "))
      )
    )
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car (setq plst (vl-sort plst (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (< (car a) (car b)) (< (cadr a) (cadr b)))))))))
    (setq d (distance p (cadr plst)))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (nextpt p plst d))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Left")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth nn rtn))) x)))) rtn))
      )
      ( (= ch "Right")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not x) (setq x (car (nth (- r nn 1) rtn))) x)))) rtn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not y) (setq y (car (nth (- r n1 n2 1) rtn))) y)))) rtn))
      )
    )
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq rtn (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) rtn))
    (vl-cmdf "_.pline")
    (foreach p rtn
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )

  (defun lines-rowsY ( / cm ss i blkx blks bb ll ur plst p pp ppp sppp mp rtn k li li1 li2 ch nn n1 n2 r x y )
    (initget 1 "Yes No")
    (setq cm (getkword "\nMiddle separation [Yes / No] : "))
    (initget 1 "Left Right Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Left / Right / Both / None] : "))
    (if (or (= ch "Left") (= ch "Right"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each row : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Left side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Right side : "))
      )
    )
    (initget 7)
    (setq r (getint "\nSpecify how many blocks, other entities or points are in each row : "))
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car-sort plst (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Left")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth nn rtn))) x)))) rtn))
        (setq r (- r nn))
      )
      ( (= ch "Right")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not x) (setq x (car (nth (- r nn 1) rtn))) x)))) rtn))
        (setq r (- r nn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not y) (setq y (car (nth (- r n1 n2 1) rtn))) y)))) rtn))
        (setq r (- r n1 n2))
      )
    )
    (setq ppp rtn)
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq k 1)
    (while rtn
      (setq k (1+ k))
      (if (= 0 (rem k 2))
        (setq li (list (car rtn) (cadr rtn)) mp (mapcar (function +) (list 1e-3 0.0 0.0) (mid (car rtn) (cadr rtn))))
        (setq li (list (cadr rtn) (car rtn)) mp (mapcar (function +) (list -1e-3 0.0 0.0) (mid (cadr rtn) (car rtn))))
      )
      (if (= (rem r 2) 0)
        (setq mp (mid (car rtn) (cadr rtn)))
      )
      (setq sppp (vl-sort (vl-remove-if-not (function (lambda ( p ) (equal (cadr p) (cadar rtn) 1e-6))) ppp) (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
      (setq sppp (list (car sppp) (cadr sppp)))
      (setq li1 (list (car li) (setq x (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b))))))))
      (setq li2 (list (car (vl-remove x sppp)) (cadr li)))
      (setq li1 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li1))
      (setq li2 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li2))
      (setq rtn (cddr rtn))
      (if (= cm "Yes")
        (progn
          (vl-cmdf "_.pline")
          (foreach p li1
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
          (vl-cmdf "_.pline")
          (foreach p li2
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
        )
        (vl-cmdf "_.pline" "_non" (car li1) "_non" (cadr li2) "")
      )
    )
  )

  (defun lines-columnsY ( / cm ss i blkx blks bb ll ur plst p d pp ppp sppp mp rtn k li li1 li2 ch nn n1 n2 c x y )
    (initget 1 "Yes No")
    (setq cm (getkword "\nMiddle separation [Yes / No] : "))
    (initget 1 "Down Up Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Down / Up / Both / None] : "))
    (if (or (= ch "Down") (= ch "Up"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each column : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Down side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Up side : "))
      )
    )
    (initget 7)
    (setq c (getint "\nSpecify how many blocks, other entities or points are in each column : "))
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car (setq plst (vl-sort plst (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (< (cadr a) (cadr b)) (< (car a) (car b)))))))))
    (setq d (distance p (cadr plst)))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (nextpt p plst d))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Down")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth nn rtn))) x)))) rtn))
        (setq c (- c nn))
      )
      ( (= ch "Up")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not x) (setq x (cadr (nth (- c nn 1) rtn))) x)))) rtn))
        (setq c (- c nn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not y) (setq y (cadr (nth (- c n1 n2 1) rtn))) y)))) rtn))
        (setq c (- c n1 n2))
      )
    )
    (setq ppp rtn)
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq k 1)
    (while rtn
      (setq k (1+ k))
      (if (= 0 (rem k 2))
        (setq li (list (car rtn) (cadr rtn)) mp (mapcar (function +) (list 0.0 1e-3 0.0) (mid (car rtn) (cadr rtn))))
        (setq li (list (cadr rtn) (car rtn)) mp (mapcar (function +) (list 0.0 -1e-3 0.0) (mid (cadr rtn) (car rtn))))
      )
      (if (= 0 (rem c 2))
        (setq mp (mid (car rtn) (cadr rtn)))
      )
      (setq sppp (vl-sort (vl-remove-if-not (function (lambda ( p ) (equal (car p) (caar rtn) 1e-6))) ppp) (function (lambda ( a b ) (< (distance mp a) (distance mp b))))))
      (setq sppp (list (car sppp) (cadr sppp)))
      (setq li1 (list (car li) (setq x (car-sort sppp (function (lambda ( a b ) (< (distance (car li) a) (distance (car li) b))))))))
      (setq li2 (list (car (vl-remove x sppp)) (cadr li)))
      (setq li1 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li1))
      (setq li2 (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) li2))
      (setq rtn (cddr rtn))
      (if (= cm "Yes")
        (progn
          (vl-cmdf "_.pline")
          (foreach p li1
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
          (vl-cmdf "_.pline")
          (foreach p li2
            (vl-cmdf "_non" p)
          )
          (vl-cmdf "")
        )
        (vl-cmdf "_.pline" "_non" (car li1) "_non" (cadr li2) "")
      )
    )
  )

  (defun path-rowsY ( / ss i blkx blks bb ll ur plst p pp rtn ch nn n1 n2 r x y )
    (initget 1 "Left Right Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Left / Right / Both / None] : "))
    (if (or (= ch "Left") (= ch "Right"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each row : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Left side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each row from Right side : "))
      )
    )
    (if (/= ch "None")
      (progn
        (initget 7)
        (setq r (getint "\nSpecify how many blocks, other entities or points are in each row : "))
      )
    )
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car-sort plst (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (car-sort plst (function (lambda ( a b ) (< (distance p a) (distance p b))))))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Left")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth nn rtn))) x)))) rtn))
      )
      ( (= ch "Right")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not x) (setq x (car (nth (- r nn 1) rtn))) x)))) rtn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (car p) 1e-6) (if (not x) (setq x (car (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (car p) 1e-6) (if (not y) (setq y (car (nth (- r n1 n2 1) rtn))) y)))) rtn))
      )
    )
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq rtn (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) rtn))
    (vl-cmdf "_.pline")
    (foreach p rtn
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )

  (defun path-columnsY ( / ss i blkx blks bb ll ur plst p d pp rtn ch nn n1 n2 c x y )
    (initget 1 "Down Up Both None")
    (setq ch (getkword "\nChoose side from where to trim pieces of blocks, other entities or points [Down / Up / Both / None] : "))
    (if (or (= ch "Down") (= ch "Up"))
      (progn
        (initget 7)
        (setq nn (getint "\nSpecify how many blocks, other entities or points you want to skip per each column : "))
      )
    )
    (if (= ch "Both")
      (progn
        (initget 7)
        (setq n1 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Down side : "))
        (initget 7)
        (setq n2 (getint "\nSpecify how many blocks, other entities or points you want to skip per each column from Up side : "))
      )
    )
    (if (/= ch "None")
      (progn
        (initget 7)
        (setq c (getint "\nSpecify how many blocks, other entities or points are in each column : "))
      )
    )
    (prompt "\nSelect grid dispositioned blocks, other entities or points...")
    (if (setq ss (ssget))
      (repeat (setq i (sslength ss))
        (setq blks (cons (ssname ss (setq i (1- i))) blks))
      )
    )
    (foreach blk blks
      (if (/= (cdr (assoc 0 (setq blkx (entget blk)))) "POINT")
        (progn
          (setq bb (ucs-bbox blk))
          (setq ll (car bb) ur (cadr bb))
          (setq plst (cons (mid ll ur) plst))
        )
        (setq plst (cons (trans (cdr (assoc 10 blkx)) 0 1) plst))
      )
    )
    (setq p (car (setq plst (vl-sort plst (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (< (cadr a) (cadr b)) (< (car a) (car b)))))))))
    (setq d (distance p (cadr plst)))
    (setq rtn (cons p rtn))
    (while plst
      (setq plst (vl-remove-if (function (lambda ( x ) (equal x p 1e-6))) plst))
      (if (setq pp (nextpt p plst d))
        (progn
          (setq rtn (cons pp rtn))
          (setq p pp)
        )
        (progn
          (if plst
            (setq rtn (cons (car plst) rtn))
          )
          (setq plst nil)
        )
      )
    )
    (setq rtn (reverse rtn))
    (cond
      ( (= ch "Down")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth nn rtn))) x)))) rtn))
      )
      ( (= ch "Up")
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not x) (setq x (cadr (nth (- c nn 1) rtn))) x)))) rtn))
      )
      ( (= ch "Both")
        (setq rtn (vl-remove-if (function (lambda ( p ) (< (+ (cadr p) 1e-6) (if (not x) (setq x (cadr (nth n1 rtn))) x)))) rtn))
        (setq rtn (vl-remove-if (function (lambda ( p ) (> (- (cadr p) 1e-6) (if (not y) (setq y (cadr (nth (- c n1 n2 1) rtn))) y)))) rtn))
      )
    )
    (setq p (car rtn))
    (foreach pp (cdr rtn)
      (if (and (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn)) (online p pp (nth (1+ (vl-position pp (cdr rtn))) (cdr rtn))))
        (progn
          (setq p pp)
          (setq rtn (vl-remove-if (function (lambda ( x ) (equal x pp 1e-6))) rtn))
        )
        (setq p pp)
      )
    )
    (setq rtn (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) rtn))
    (vl-cmdf "_.pline")
    (foreach p rtn
      (vl-cmdf "_non" p)
    )
    (vl-cmdf "")
  )

  (if (= chh "X")
    (cond
      ( (and (= ch1 "Lines") (= ch2 "Rows"))
        (lines-rowsX)
      )
      ( (and (= ch1 "Lines") (= ch2 "Columns"))
        (lines-columnsX)
      )
      ( (and (= ch1 "Path") (= ch2 "Rows"))
        (path-rowsX)
      )
      ( (and (= ch1 "Path") (= ch2 "Columns"))
        (path-columnsX)
      )
    )
    (cond
      ( (and (= ch1 "Lines") (= ch2 "Rows"))
        (lines-rowsY)
      )
      ( (and (= ch1 "Lines") (= ch2 "Columns"))
        (lines-columnsY)
      )
      ( (and (= ch1 "Path") (= ch2 "Rows"))
        (path-rowsY)
      )
      ( (and (= ch1 "Path") (= ch2 "Columns"))
        (path-columnsY)
      )
    )
  )
  (*error* nil)
)

 

Regards, M.R.

 

 

grid-blks.lsp

Edited January 28 by marko_ribar

[marko_ribar]

@Tamim

I finally finished *.lsp posted at my previous message and I think that I won't further edit it as it satisfies all my needs and I hope yours... Because of file size, I decided to upload *.lsp in my previous message along with code in code tags as copy+paste of large files can be tricky...

Now, I'd mark my previous message as a solution as it should be this post where I further developed LISP to suit all possible situations what may occur...

 

Regards, best wishes and happy coding...

M.R.