Jump to content

Diagonal Lines for Outer rectangles to Inner rectangle


Raje

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...