Diagonal Lines for Outer rectangles to Inner rectangle

[Raje]

Can some one help? need Diagonal Lines by selecting all and draw Diagonal lines in between outer rectangle to inner maximum size rectangle.

Thank you.

[Tharwat]

Hi,

Be sure to have the external rectangles visible in the screen and just select the external rectangles as the message of the program indicates to:

(defun c:Test (/ int sel ent rct pts vol nos are obj big lst dis lng pnt)
  ;;	Tharwat - Date: 09.Nov.2017	;;
  (princ "\nSelect external Rectangles only with four corners :")
  (if (setq int -1 sel (ssget '((0 . "LWPOLYLINE") (90 . 4))))
    (while (setq ent (ssname sel (setq int (1+ int))))
      (and
        (setq rct (ssget "_WP"
                         (setq pts (mapcar 'cdr
                                           (vl-remove-if-not
                                             '(lambda (p) (eq (car p) 10))
                                             (entget ent)
                                           )
                                   )
                         )
                         '((0 . "LWPOLYLINE") (90 . 4))
                  )
        )
        (progn
          (setq vol 0.0)
          (repeat (setq nos (sslength rct))
            (if (> (setq
                     are (vlax-curve-getarea
                           (setq obj (ssname rct (setq nos (1- nos))))
                         )
                   )
                   vol
                )
              (setq vol are
                    big obj
              )
            )
          )
          big
        )
        (= (length (setq lst (mapcar 'cdr
                                     (vl-remove-if-not
                                       '(lambda (p) (eq (car p) 10))
                                       (entget big)
                                     )
                             )
                   )
           )
           4
        )
        (mapcar
          '(lambda (vrx)
             (setq pnt (car lst)
                   dis (distance vrx pnt)
             )
             (mapcar '(lambda (cor)
                        (if (< (setq lng (distance vrx cor)) dis)
                          (setq pnt cor
                                dis lng
                          )
                        )
                      )
                     lst
             )
             (entmake (list '(0 . "LINE") (cons 10 vrx) (cons 11 pnt)))
           )
          pts
        )
      )
    )
  )
  (princ)
) (vl-load-com)

[Raje]

hi Tharwat,
thank you..it is perfect working.

[ronjonp]

Here's another for fun

(defun c:foo (/ b p pts s s2 x)
  ;; RJP - 11.19.2017
  ;; Code assumes that the outer polylines have the same area
  (if
    (and
      (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>") (90 . 4))))
      (setq s (vl-sort (mapcar '(lambda (x) (cons (vlax-curve-getarea x) x))
			       (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
		       )
		       '(lambda (a b) (> (car a) (car b)))
	      )
      )
      (setq s (vl-remove-if
		'(lambda (x) (and (equal (caar s) (car x) 1e-8) (setq s2 (cons (cdr x) s2))))
		s
	      )
      )
      (setq s (mapcar 'cdr s))
    )
     (foreach a	s2
       (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget a))))
       (setq p (car pts))
       (if (setq b (car	(vl-sort s
				 '(lambda (a b)
				    (< (distance p (vlax-curve-getclosestpointto a p))
				       (distance p (vlax-curve-getclosestpointto b p))
				    )
				  )
			)
		   )
	   )
	 (foreach p pts
	   (entmakex (list '(0 . "line")
			   (assoc 8 (entget a))
			   (cons 10 p)
			   (cons 11 (vlax-curve-getclosestpointto b p))
		     )
	   )
	 )
       )
     )
  )
  (princ)
)
(vl-load-com)

[Tharwat]

hi Tharwat,
thank you..it is perfect working.

You are welcome.

[Raje]

helo ronjonp,
another version of your code also excellent.

Thankyou....

[ronjonp]

helo ronjonp,
another version of your code also excellent.

Thankyou....

Glad to help

[Raje]

helo ronjonp,
if different size of outer rectangles not getting diagonal lines. please fix to work any size outer rectangles.

Thank you...

[ronjonp]

helo ronjonp,
if different size of outer rectangles not getting diagonal lines. please fix to work any size outer rectangles.

Thank you...

Post an example drawing. We'd need to define an area rule of what is considered an 'outer' rectangle.

Actually try this:

(defun c:foo (/ b p pts s s2 x)
  ;; RJP - 11.10.2017
  (if
    (and
      (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>") (90 . 4))))
      (setq s (vl-sort (mapcar '(lambda (x) (cons (vlax-curve-getarea x) x))
			       (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
		       )
		       '(lambda (a b) (> (car a) (car b)))
	      )
      )
      (setq s (vl-remove-if
		'(lambda (x) (and (> (/ (car x) (caar s)) 0.5) (setq s2 (cons (cdr x) s2))))
		s
	      )
      )
      (setq s (mapcar 'cdr s))
    )
     (foreach a	s2
       (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget a))))
       (setq p (car pts))
       (if (setq b (car	(vl-sort s
				 '(lambda (a b)
				    (< (distance p (vlax-curve-getclosestpointto a p))
				       (distance p (vlax-curve-getclosestpointto b p))
				    )
				  )
			)
		   )
	   )
	 (foreach p pts
	   (entmakex (list '(0 . "line")
			   (assoc 8 (entget a))
			   (cons 10 p)
			   (cons 11 (vlax-curve-getclosestpointto b p))
		     )
	   )
	 )
       )
     )
  )
  (princ)
)
(vl-load-com)

[Raje]

hi ronjonp,

it is working. thank you for updating code and advice.