Creating hidden rectangles... (a little math squeeze for your brain)

hi

its been long time since i wrote any lisps,

please help me to get into it again,

i have a closed polyline which i called region A,

by executing the lisp i want the following to happen,

i want to determine and create region B, C,E and D

Thanks

S

A quick thought enter x & y dist, use Break new ptx dist away from cnr point repeat for Y draw a line new xpt with length = Y draw a new line from end point of line to vertical then just used pedit to add the two new line to existing pline.

Sequence pick corner enter X & Y note Positive and Negatives will effect the result or test if point returns an object but it could find another object nearby.

I tested manually and it worked. Made 1st Break pt the new pt then picked corner.

Found a few minutes it needs positive or negative for directions but that could be version 2.

Lower left x&Y positive Lower right x -ve y +ve and so on.

(defun c:test ( / x y newpt pt ptx pty ent entt aunitsold angdirold angbaseold osmodeold)
(setq aunitsold (getvar 'aunits)
angdirold (getvar 'angdir)
angbaseold (getvar 'angbase)
osmodeold (getvar 'osmode)
)

(setvar 'aunits 3)
(setvar 'angdir 0) ; clockwise
(setvar 'angbase 0)
(setq pt (getpoint "pick corner point"))
(setq entt (ssget pt))
(setvar "osmode" 512)
(setq x (getreal "distance x "))
(setq Y (getreal "Distance Y "))
(setq ptx (polar pt 0.0 x))
(setq pty (polar pt (/ pi 2.0) Y))
(command "break" ptx pt)
(command "break" pty pt)
(setq newpt (list (car ptx) (cadr pty)))
(command "pline" ptx newpt pty "")
(setq ent (entlast))
(command "join" ent (ssname entt 0) "")
(setvar 'aunits aunitsold)
(setvar 'angdir angdirold) ; clockwise
(setvar 'angbase angbaseold)
(setvar 'osmode osmodeold)
)

Others may want to jump in and be a bit more creative than my method and add some others to a "Notch pline.lsp" I was thinking of a dist from end, Length & Height, a couple of circle and arc/circle routines. Shape notcher etc. Draw a pline and it notches to that shape. Not something we do so happy to listen to some ideas.

My understanding of the problem is quite different:

Given a 'notched' polyline, create a grid of rectangles to fill up the notched out area.

My understanding of the problem is quite different:

Given a 'notched' polyline, create a grid of rectangles to fill up the notched out area.

That is how I read it too.

For all the good that will do, as I couldn't write the code either way.

I could have done that but the 3rd object did not show that and after all it could be added pretty easy as the code has the 4 points I would add a line calling a extra defun to draw the 4 side new pline. Rem it out for just notches.

Dadgad just for you have a go where to put this line and new plines are created as well.

(command "Pline" ptx pt pty newpt "c")

Ok I just realised a slight problem so will need to add the the new plines last, not a problem just make a list of lists its going to rain tomorrow so will have some time to do it.

SAmifox do you want the new rectangs as well ?

Assuming all segments of polyline A are orthogonal to X or Y axis the WCS:

1. Create a list of polyline vertices.
   
2. Create sorted lists of X and Y coordinates.
   
3. With those lists calculate a grid of rectangles ((BL TR) (BL TR) ...).
   
4. For each rectangle in the grid determine if its center lies outside polyline A. If that is the case create the rectangle.
   
5. The outer rectangle can be derived from the bounding box of polyline A.
   

This is version 2 and adds rectangles.

; Pick a corner and notch the pline
; By Alan H May 2017
(defun c:test ( / x y newpt pt ptx pty entt ent newpl)
(setvar 'osmode 47)
(setq aunitsold (getvar 'aunits)
angdirold (getvar 'angdir)
angbaseold (getvar 'angbase)
osmodeold (getvar 'osmode)
)

(setvar 'aunits 3)
(setvar 'angdir 0) ; clockwise
(setvar 'angbase 0)(setvar 'osmode osmodeold)
(setq newpl '())

(while (setq pt (getpoint "pick corner point"))
(setq entt (ssget pt))
(setvar "osmode" 512)
(setq x (getreal "distance x "))
(setq Y (getreal "Distance Y "))
(setq ptx (polar pt 0.0 x))
(setq pty (polar pt (/ pi 2.0) Y))
(command "break" ptx pt)
(command "break" pty pt)
(setq newpt (list (car ptx) (cadr pty)))
(command "pline" ptx newpt pty "")
(setq ent (entlast))
(command "join" ent (ssname entt 0) "")
(princ (setq newpl (cons (list ptx pt pty newpt) newpl)))
(setvar 'osmode osmodeold)
(setq entt nil)
) ;while

(setq x 0 
y 0)
(repeat (length newpl)
(command "Pline" )
(repeat 4
(command (nth y (nth x newpl)))
(setq y (+ y 1))
) ;r4
(command "c")
(setq x (+ x 1))
(setq y 0)
) ;repeat

(setvar 'aunits aunitsold)
(setvar 'angdir angdirold) ; clockwise
(setvar 'angbase angbaseold)
(setvar 'osmode osmodeold)
)

I like these math brain puzzles. Since Samifox didn't reply, I is what I assumed

-all segments of polyline A are orthogonal to X or Y axis the WCS

-polyline A will always be notched like in illustration

-specifically referring to starting polyline as "region A" that all other wanted regions are polylines too.

My version only requires the user to select the starting LWpline. I added some selection error trapping that will prevent the user to miss-click or select something else than a lwpoly, Using an available toy (LM:boundingbox) to find out the missing coord of the B region (LWPoly) which in turn is used to calculate the missing intersections. No "commands" have been used or mistreated during the creation of that lisp routine

(defun c:test ( / POI startpoly bb startpolyvertex openlimit ;vars
              LM:boundingbox LWPoly extractlwcoords)        ;subs
 ;Jef! mai 2017
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;                   SUBS                   ;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; http://www.lee-mac.com/boundingbox.html
 ;; Bounding Box  -  Lee Mac
 ;; Returns the point list describing the rectangular frame bounding the supplied object.
 ;; obj - [vla] VLA-Object
 (defun LM:boundingbox ( obj / a b lst )
     (if
         (and
             (vlax-method-applicable-p obj 'getboundingbox)
             (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
             (setq lst (mapcar 'vlax-safearray->list (list a b)))
         )
         (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
            '(
                 (caar   cadar)
                 (caadr  cadar)
                 (caadr cadadr)
                 (caar  cadadr)
             )
         )
     )
 )

 ; Jef! mai 2017
 ; create a closed LWpoly with a list of points provided as argument
 (defun LWPoly (lst)
    (entmakex (append (list (cons 0 "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length lst))
                            (cons 70 1))
                      (mapcar (function (lambda (p) (cons 10 p))) lst))))

 ; Jef! mai 2017
 ; Extract the coords of a LWpoly. pline - <EName>
 ; (remove consecutive coordinates if they are identical)
 (defun extractlwcoords (pline / retlist)
    (foreach dxf (entget pline)
      (if (and (= 10 (car dxf))
               (not (equal (cdr dxf) (car retlist) 1e-)
          )
        (setq retlist (cons (cdr dxf) retlist))
      )
    )
    (if (equal (car retlist) (last retlist) 1e-
        (cdr retlist)
         retlist
    )
  )
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;                   MAIN                   ;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (while (not (and (setq startpoly (car(entsel "\nSelect the polyline: ")))
	   (= (cdr (assoc 0 (entget startpoly)))"LWPOLYLINE")
             )
 )
 (if startpoly
               (princ "\nYou must select an polyline.")
           	(princ "\nYou missed, try again.")
        )
 )
 (setq bb (LM:boundingbox(vlax-ename->vla-object startpoly)))
 (setq startpolyvertex (extractlwcoords startpoly))
 (foreach coord bb
   (if (not (member coord startpolyvertex))
     (setq openlimit coord)
   )
 )
 (while (not(equal openlimit (car bb) 1e-)
   (setq bb (cons (last bb)(reverse(cdr(reverse bb)))))
 )
 (while (not(equal (cadr bb) (car startpolyvertex)1e-)
   (setq startpolyvertex (cons (last startpolyvertex)(reverse(cdr(reverse startpolyvertex)))))
 )
 (if (not (vl-every '(lambda (x1 x2) (equal x1 x2 1e-) (cdr bb) (vl-remove-if-not '(lambda (x) (member x bb)) startpolyvertex) ))
     (progn
        (setq startpolyvertex (reverse startpolyvertex))
        (while (not(equal (cadr bb) (car startpolyvertex)1e-)
          (setq startpolyvertex (cons (last startpolyvertex)(reverse(cdr(reverse startpolyvertex)))))
        )
     )
 )
 (foreach coord startpolyvertex
   (if (not (member coord bb))
       (setq POI (cons coord POI))
   )
 )
 (setq POI (reverse POI))
 (LWPoly (list (nth 0 POI)(nth 1 POI)(nth 2 POI) (inters (nth 3 POI)(nth 2 POI)(nth 0 POI)openlimit nil)))
 (LWPoly (list (nth 4 POI)(nth 3 POI)(nth 2 POI) (inters (nth 1 POI)(nth 2 POI)(nth 4 POI)openlimit nil)))
 (LWPoly (list openlimit (inters (nth 3 POI)(nth 2 POI)(nth 0 POI)openlimit nil) (nth 2 POI) (inters (nth 1 POI)(nth 2 POI)(nth 4 POI)openlimit nil)))
 (LWPoly bb)
 (princ)             
)

It was a fun math puzzle! Hope you like it!

Cheers!