samifox Posted May 24, 2017 Share Posted May 24, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 25, 2017 Share Posted May 25, 2017 (edited) 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) ) Edited May 28, 2017 by BIGAL Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 26, 2017 Share Posted May 26, 2017 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. Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted May 26, 2017 Share Posted May 26, 2017 My understanding of the problem is quite different: Given a 'notched' polyline, create a grid of rectangles to fill up the notched out area. Quote Link to comment Share on other sites More sharing options...
Dadgad Posted May 26, 2017 Share Posted May 26, 2017 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 27, 2017 Share Posted May 27, 2017 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 ? Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted May 27, 2017 Share Posted May 27, 2017 Assuming all segments of polyline A are orthogonal to X or Y axis the WCS: Create a list of polyline vertices. Create sorted lists of X and Y coordinates. With those lists calculate a grid of rectangles ((BL TR) (BL TR) ...). For each rectangle in the grid determine if its center lies outside polyline A. If that is the case create the rectangle. The outer rectangle can be derived from the bounding box of polyline A. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 28, 2017 Share Posted May 28, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
Jef! Posted June 1, 2017 Share Posted June 1, 2017 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! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.