Jump to content
Raje

Diagonal Lines for Outer rectangles to Inner rectangle

Recommended Posts

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.

Diagnol Lines.dwg

Share this post


Link to post
Share on other sites
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)

RECTS.gif

Share this post


Link to post
Share on other sites
Raje

hi Tharwat,

thank you..it is perfect working.

Share this post


Link to post
Share on other sites
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- (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)

2017-11-09_08-29-49.gif

Share this post


Link to post
Share on other sites
Tharwat
hi Tharwat,

thank you..it is perfect working.

 

You are welcome.

Share this post


Link to post
Share on other sites
Raje

helo ronjonp,

another version of your code also excellent.

 

Thankyou....

Share this post


Link to post
Share on other sites
ronjonp
helo ronjonp,

another version of your code also excellent.

 

Thankyou....

 

Glad to help :)

Share this post


Link to post
Share on other sites
Raje

helo ronjonp,

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

 

Thank you...

Share this post


Link to post
Share on other sites
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)

2017-11-10_09-11-24.gif

Edited by ronjonp

Share this post


Link to post
Share on other sites
Raje

hi ronjonp,

 

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

Share this post


Link to post
Share on other sites
ronjonp

Glad to help. BTW .. why don't you create blocks for these?

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×