Draw polyline inside the rectangle lisp

[veteranus]

Hi,

 

Can I draw a straight polyline (with my selected layer) into multiple rectangles based on the long edge?

 

For example:

 

http://prntscr.com/oxmpjh

 

 

 

[dlanorh]

Are the rectangle lines or polylines? A sample drawing always helps (for me saved as 2010).

[BIGAL]

If lines can use Join command 1st for this request simpler for user to do join 1st and only write code for plines. Edit for desired layer name.

 

(defun test (/ pt1 pt2 pt3 pt4 d1 d2 ss x1 y1 x2 y2 oldsnap oldlay)
  (setq oldsnap (getvar 'osmode))
  (setq oldlay (getvar 'clayer))


;(setvar 'clayer your layername) change to your layer name 


  (setq lay (cdr (assoc 8 (entget (car (entsel "pick a pline"))))))
  (setq ss (ssget (list (cons 0 "lwpolyline") (cons 8 lay))))
  (setvar 'osmode 0)


  (repeat (setq x (sslength ss))
    (setq co-ord '())
    (setq plent (ssname ss (setq x (1- x))))
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
    (if (= (length co-ord) 4)
      (progn
        (setq pt1 (nth 0 co-ord))
        (setq pt2 (nth 1 co-ord))
        (setq pt3 (nth 2 co-ord))
        (setq pt4 (nth 3 co-ord))
        (setq d1 (distance pt1 pt2))
        (setq d2 (distance pt2 pt3))
        (If (< d1 d2)
          (progn
            (setq x1 (/ (+ (car pt1) (car pt2)) 2.0))
            (setq y1 (/ (+ (cadr pt1) (cadr pt2)) 2.0))
            (setq x2 (/ (+ (car pt3) (car pt4)) 2.0))
            (setq y2 (/ (+ (cadr pt3) (cadr pt4)) 2.0))
            (command "line" (list x1 y1) (list x2 y2) "")
          )
          (progn
            (setq x1 (/ (+ (car pt2) (car pt3)) 2.0))
            (setq y1 (/ (+ (cadr pt2) (cadr pt3)) 2.0))
            (setq x2 (/ (+ (car pt1) (car pt4)) 2.0))
            (setq y2 (/ (+ (cadr pt1) (cadr pt4)) 2.0))
            (command "line" (list x1 y1) (list x2 y2) "")
          )
        )
      )
      (alert " Object has less or more than 4 sides\n \n So skipped")
    )
  )


  (setvar 'osmode oldsnap)
  (setvar 'clayer oldlay)


  (princ)
)
(test)

 

 

 

 

[veteranus]

Hi again and sorry for delay,

 

Dear dlanorh these are polylines.

 

Dear BIGAL your lisp code is working like charm.

 

Thank you guys both and have a nice day.

 

Regards.

[ronjonp]

Here's another way to do it. Does not work on squares.

(defun c:foo (/ pts s)
  ;; RJP » 2019-08-27
  (cond	((setq s (ssget '((0 . "lwpolyline") (90 . 4))))
	 (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq pts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pl))))
	   (setq
	     pts (mapcar '(lambda (r j) (list (distance r j) (mapcar '/ (mapcar '+ r j) '(2 2 2))))
			 pts
			 (append (cdr pts) (list (car pts)))
		 )
	   )
	   (setq pts (vl-sort pts '(lambda (r j) (< (car r) (car j)))))
	   (entmakex (list '(0 . "line")
			   '(8 . "line")
			   '(62 . 1)
			   (cons 10 (cadr (car pts)))
			   (cons 11 (cadr (cadr pts)))
		     )
	   )
	 )
	)
  )
  (princ)
)

 

[BIGAL]

Glad to help like ronjonp a square may not give correct answer. Same with some odd sized shapes see image above as I only do a simple compare.

[veteranus]

14 hours ago, ronjonp said:

Here's another way to do it. Does not work on squares.

(defun c:foo (/ pts s)
  ;; RJP » 2019-08-27
  (cond	((setq s (ssget '((0 . "lwpolyline") (90 . 4))))
	 (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq pts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pl))))
	   (setq
	     pts (mapcar '(lambda (r j) (list (distance r j) (mapcar '/ (mapcar '+ r j) '(2 2 2))))
			 pts
			 (append (cdr pts) (list (car pts)))
		 )
	   )
	   (setq pts (vl-sort pts '(lambda (r j) (< (car r) (car j)))))
	   (entmakex (list '(0 . "line")
			   '(8 . "line")
			   '(62 . 1)
			   (cons 10 (cadr (car pts)))
			   (cons 11 (cadr (cadr pts)))
		     )
	   )
	 )
	)
  )
  (princ)
)

 

 

Hi,

 

The code works but automatically opens the "line" layer and draws the middle line with it. Is it possible to draw with the selected layer?

[ronjonp]

Sure.

 

Change this:

'(8 . "line")

To this:

(assoc 8 pl)

 

Edited August 28, 2019 by ronjonp

[BIGAL]

Your screen grab shows new lines as a different colour hence ronjonp code is correct using a different layer it does not have to be "Lines" or in mine 

 

;(setvar 'clayer yourlayername) change to your layer name

 

If you want same layer and a different color and line type need to advise can be done in both code provided. ronjonp entmake mine chprop probably.

[mdivy10]

Hello, this is a great LISP. Is there a way you could rewrite to create the red centerline with a 3D polyline instead of polyline? 

I am looking to replace a 3D polyline rectangle (white) with a single 3D polyline down the center (red) that will have Z1 be the north value and Z2 be the south value. Thanks.