extract rectangle points

How would you extract all four points from the corners in a rectangle?

TIA

 

Since a "rectangle" is just a closed polyline, you could use something like
POLYPT.LSP from
http://www.turvill.com/t2/free_stuff
___

 

how do you extract the all the x and y points with lisp?

 

Stephen,
Try something like this:

;; Extract all 4 corners of a rectangle. Lists X and Y values.
(defun C:exam_rect ()
(prompt "\n ")
(setq P1 (getpoint "\nPick a Corner of the Rectangle:"))
(setq P3 (getpoint "\nPick Opposite Corner:"))
(if (and P1 P3)
(progn
(setq X1 (car P1))
(setq X3 (car P3))
(setq Y1 (cadr P1))
(setq Y3 (cadr P3))
(setq P2 (list X3 Y1))
(setq P4 (list X1 Y3))
(setq X2 (car P2))
(setq Y2 (cadr P2))
(setq X4 (car P4))
(setq Y4 (cadr P4))
(prompt "\n4 Corner Points:")
(prompt (strcat "\nFirst Corner X = " (rtos X1) " Y = " (rtos Y1)))
(prompt (strcat "\nSecond Corner X = " (rtos X2) " Y = " (rtos Y2)))
(prompt (strcat "\nThird Corner X = " (rtos X3) " Y = " (rtos Y3)))
(prompt (strcat "\nForth Corner X = " (rtos X4) " Y = " (rtos Y4)))
(princ)
); progn
); if
); function

Bob

 

Watch out for word wrap.

(defun @ptlist (Object / Param ptlist)
;; This should work with any polyline or leader
;; so long as it's not nested in a block.
;; Coordinates returned are in WCS.
(and
(vl-load-com)
(cond
((= (type Object) 'VLA-Object))
((= (type Object) 'ENAME)
(setq Object (vlax-ename->vla-object Object))
)
(1 (prompt " Invalid object."))
)
(or
(wcmatch
(vlax-get Object 'ObjectName)
"AcDb*Polyline,AcDbLeader"
)
(prompt " Object is not a leader or polyline.")
)
;; Sometimes using a Param of 0 doesn't work,
;; so grab the StartPoint instead.
(setq ptlist (list (vlax-curve-getstartpoint object)))
(setq Param 1.0)
(repeat (1- (fix (vlax-curve-getendparam Object)))
(setq ptlist (cons (vlax-curve-getpointatparam Object Param) ptlist)
Param (1+ Param)
)
)
;; Sometimes using End Param doesn't work,
;; so grab the EndPoint instead.
(setq ptlist (cons (vlax-curve-getendpoint Object) ptlist))
)
(reverse ptlist)
)

 

(vlax-get
(vlax-ename->vla-object <ename of polyline>)
'coordinates)

;;will give you a flat list of x and y coordinates in the form:
;;(x1 y1 x2 y2 .....xn yn)

 

Doug:

Much simpler = yes. But you have to know what kind of polyline you're dealing
with in order to group the flat list.
I know you know this; I'm just explaining to the OP <thanks, I didn't know that
one until you explained the other day> and any lurkers...

A LWPOLYLINE (aka "AcDbPolyline") returns coordinates as (x1 y1 x2 y2 ... xn
yn).

A 2D "heavy" POLYLINE (aka "AcDb2dPolyline") and a 3D POLYLINE (aka
"AcDb3dPolyline") both return coordinates as (x1 y1 z1 x2 y2 z2 ... xn yn zn).

An AcDb2dPolyline that has been fit-curved or splined will have additional
vertices that the 'Coordinates property will not reveal.

For example, take a fit-curved polyline...
Command: (length (@cv_triple_up (vlax-get Object 'Coordinates)))
4

Command: (length (@ptlist Object))
7

where:
(defun @cv_triple_up (old / new)
;; Thanks to Ken Alexander and Tony Tanzillo
(and
old
(while
(setq new (cons (list (car old)(cadr old)(caddr old)) new)
old (cdddr old)
)
)
)
(reverse new)
)

Not to mention...
Command: (timer '(length (@cv_triple_up (vlax-get object 'coordinates))) 1000)
Elapsed time for 1000 iterations: 1.48 secs.
4

Command: (timer '(length (@ptlist object)) 1000)
Elapsed time for 1000 iterations: 0.60 secs.
7

where:
(defun timer (fun n / start stop)
(setq start (getvar "date"))
(repeat n (eval fun))
(setq stop (getvar "date"))
(princ (strcat "Elapsed time for " (itoa n) " iterations: " (rtos (* 86400.0
(- stop start)) 2 2) " secs.\n"))
(eval fun)
)

The times for a 390 vertex 3D polyline were 103 secs. vs. 19 secs. on my now old
P3/1.2GHz laptop in LDT3 (2002).

Looks like I'll have to update a bundle of programs that currently use the
'Coordinates property. :/

 

Good points John.

However, if you know that you are operating on a lwpolyline and
you don't care if the points are grouped, then the time data is
pretty remarkably different from your post.

(bench '(test1 @ptlist) (list obj) 1000)

where obj is a 39 point polyline and test1 is defined as

(defun test1 (obj) (vlax-get obj 'coordinates))

The time data on my computer is:
TEST1
Elapsed: 62
Average: 0.0620

@PTLIST
Elapsed: 1563
Average: 1.5630

Now if I group the coordinates with a function I wrote:

(defun 2dpoints (flatlist);DCB04
(if flatlist
(cons (cons
(car flatlist)
(cons (cadr flatlist) nil))
(2dpoints (cddr flatlist)))))

and write another test function:

(defun test2 (obj)
(2dpoints (vlax-get obj 'coordinates)))

I get timing data like:

(bench '(test2 @ptlist) (list obj) 1000)

TEST2
Elapsed: 203
Average: 0.2030

@PTLIST
Elapsed: 1562
Average: 1.5620


There could be a reason that the length of the lists varies in your tests.
If both functions test lwpolylines, then a tripleup function wouldn't be
appropriate. You'd be grouping the coordinates like
'((x1 y1 x2)(y2 x3 y3)(x4 y4 x5)...))


I agree with your other points. Its important to know what you are testing.
I'm not sure about curve fit polylines having more coordinates though.

Good to hear from you.

Regards,
Doug

 

Another reason, that I would be reticent about using @ptlist on
a lwpolyline is the assumption that the x and y and z values represent
world or current user coordinates. These assumptions can easily
be incorrect.

For example @ptlist returns a point list with z=0 for each point
regardless of the elevation property of the polyline and regardless
of the normal property.

Regards,
Doug

 

Doug:

Just where was that 2dpoints function when I needed it? That's great!
If I got it correct, then...
(defun 3dpoints (flatlist);DCB04
(if flatlist
(cons
(cons
(car flatlist)
(cons
(cadr flatlist)
(cons (caddr flatlist) nil)
)
)
(3dpoints (cdddr flatlist))
)
)
)

Sure changes the speed analysis.

 

Um, that's not true about @ptlist ignoring elevations and normals; it always
returns a list of 3D points in WCS, as was stated. 2dpoints ignores these
things and returns a 2D list. Then again, it's all in the context of how you're
going to use the data. If you're going to modify the 'Coordinates property,
then it might be better to stick to a 2D list and let the 'Elevation and 'Normal
properties affect the result.

 

Hi Again.
I was wrong about @ptlist ignoring the elevation and returning
non WCS points. It does do those things well.

The coordinates properties, however, do not change if the object is
elevated and/or rotated about the x-axis for example and therefore
obtaining WCS points from the coordinate list would be more involved.
So 2dpoints would be insufficient to determine the 3d relationships.

I agree with your analysis. Nice to chat.

Regards,
Doug

 

That should be a correct translation. ;-)

<snip>

 

Whew. You had me worried a little. Thanks much for the contribution. You
always have this gift of helping us learn a little more.

 

Ken's ego might be a little put back, but I figure we're all put ahead. Thanks,
Doug. Nice work!

 

basically I am looking for a one mouse click that can pick the center or midpoint of any rectangle. Thanks

 

I think you should have said that up front.

Look back to April 4, 2004 for the @cv_inside function. That may or may not
help.

midpoint of any rectangle. Thanks

 

My colaboration:

;;RETANG POINTS - BEGIN
(defun C:RP (/ ENT ELST PTS SS1 OLDOSM INS OBJ PT1 P1 P2 P3 P4)
(setvar "cmdecho" 0)
(setq OLDOSM (getvar "osmode"))
(if
(and (setq ENT (car (entsel "\n Select a Rectangle or 4 Sides Polygon: ")))
(eq (cdadr (setq ELST (entget ent))) "LWPOLYLINE"))
(progn
(foreach item ELST
(if (eq (car item) 10)
(setq pts (cons (cdr item) PTS))))
(setq P1 (car PTS))(command "text" "justify" "MC" P1 "0" "P1")
(setq P3 (caddr PTS))(command "text" "justify" "MC" P3 "0" "P3")
(setq P2 (cadr PTS))(command "text" "justify" "MC" P2 "0" "P2")
(setq P4 (last PTS))(command "text" "justify" "MC" P4 "0" "P4")
))
(setvar "osmode" OLDOSM)
(princ "\n Done!")
(princ))
;;RETANG POINTS - END

 

with some modifing, hey hey Got the one click rectange mid point to work from you lisp, Thanks Rogerio

 

If errors, check STYLE, please.

Other options:

;;RETANG MID POINTS - BEGIN
(defun C:RRP (/ ENT ELST PTS SS1 OLDOSM)
(setvar "cmdecho" 1)
(COMMAND "STYLE" "STANDARD" "" "0" "1" "0" "N" "N")
(setq OLDOSM (getvar "osmode"))
(setvar "osmode" 0)
(if
(and (setq ENT (car (entsel "\n Select a Rectangle or 4 Sides Polygon: ")))
(eq (cdadr (setq ELST (entget ent))) "LWPOLYLINE"))
(progn
(foreach item ELST
(if (eq (car item) 10)
(setq pts (cons (cdr item) PTS))))
(setq P1 (car PTS))
(setq P3 (caddr PTS))
(setq P2 (cadr PTS))
(setq P4 (last PTS))
))
;_______________________________________________________________________________________
;;;(setq INT (inters P1 P3 P2 P4));;
(SETQ INT (polar P1 (ANGLE P1 P3)(/ (distance P1 P3)2)))(command "text" "justify" "MC" INT "" "0" "INT")
;_______________________________________________________________________________________
(setq M- (polar P1 (ANGLE P1 P4)(/ (distance P1 P4)2)))(command "text" "justify" "MC" M- "" "0" "M-")
;_______________________________________________________________________________________
(SETQ M+ (polar P2 (ANGLE P2 P3)(/ (distance P2 P3)2)))(command "text" "justify" "MC" M+ "" "0" "M+")
;_______________________________________________________________________________________
(SETQ MC- (polar P3 (ANGLE P3 P4)(/ (distance P3 P4)2)))(command "text" "justify" "MC" MC- "" "0" "MC-")
;_______________________________________________________________________________________
(SETQ MC+ (polar P1 (ANGLE P1 P2)(/ (distance P1 P2)2)))(command "text" "justify" "MC" MC+ "" "0" "MC+")
;_______________________________________________________________________________________
(setvar "osmode" OLDOSM)
(princ "\n Done!")
(princ))
;;RETANG MID POINTS - END
;;RETANG POINTS - BEGIN
(defun C:RP (/ ENT ELST PTS SS1 OLDOSM INS OBJ PT1 P1 P2 P3 P4)
(setvar "cmdecho" 1)
(COMMAND "STYLE" "STANDARD" "" "0" "1" "0" "N" "N")
(setq OLDOSM (getvar "osmode"))
(if
(and (setq ENT (car (entsel "\n Select a Rectangle or 4 Sides Polygon: ")))
(eq (cdadr (setq ELST (entget ent))) "LWPOLYLINE"))
(progn
(foreach item ELST
(if (eq (car item) 10)
(setq pts (cons (cdr item) PTS))))
(setq P1 (car PTS))(command "text" "justify" "MC" P1 "" "0" "P1")
(setq P3 (caddr PTS))(command "text" "justify" "MC" P3 "" "0" "P3")
(setq P2 (cadr PTS))(command "text" "justify" "MC" P2 "" "0" "P2")
(setq P4 (last PTS))(command "text" "justify" "MC" P4 "" "0" "P4")
))
(setvar "osmode" OLDOSM)
(princ "\n Done!")
(princ))
;;RETANG POINTS - END