Not able to get the third point to create a new rectangle

[RLispLearner]

Hello all

I think I’m not getting the third point (pt3gap) in my rectangle correctly when I try to draw a new one. 

 

Goal:

-create a rectangle.

-Get the Area (reca) of that rectangle created. Length (recl) x Width (recw).

-Create a variable called Gap. Value is based on the Area found.

-Multiply the length of the rectangle by 2. Then add the Gap distance.

-Create another rectangle based on new length (recl * 2 + Gap)

-Delete old rectangle

 

Illustration:

 

 

My Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Draw a rectangle. A new rectangle is then created that is twice the length (plus the gap);;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:newrec ( /  recl recw reca gap pt2gap pt3gap )

;Draw a rectangle
  (VL-LOAD-COM)
  (command-s "_.rectang"); [draw rectangle corner to corner]
  (setq
    pt1 (vlax-curve-getPointAtParam (entlast) 0)
    pt2 (vlax-curve-getPointAtParam (entlast) 1)
    pt3 (vlax-curve-getPointAtParam (entlast) 2)
    pt4 (vlax-curve-getPointAtParam (entlast) 3)
  ); setq

;Save first rectangle
(setq firstrec (cdr(assoc -1(entget (entlast)))))

;Get dimensions of the rectangle drawn
(setq recl (distance pt1 pt2)); length of rectangle
(setq recw (distance pt1 pt4)); width of rectangle
(setq reca (* recl recw)); Get area of rectangle (length x width)

; Set the gap distance based on the area (reca) of the drawn rectangle
(setq gap 0) 

    (if
        (and
          (>= reca 0)
          (<= reca 40)
        ); End and
        (setq gap 4)
    ); End IF

    (if
        (and
          (>= reca 41)
          (<= reca 60)
        ); End and
        (setq gap 6)
    ); End IF


    (if
        (and
          (>= reca 61)
          (<= reca 80)
        ); End and
        (setq gap 8)
    ); End IF

    (if
        (and
            (>= reca 81)
          (<= reca 100)
        ); End and
        (setq gap 10)
    ); End IF

    (if
        (and
          (> reca 100)
        ); End 
        (setq gap 12)
    ); End IF

;Now find the total length. Two rectangles (plus the gap). width is stil the same "recw"

(setq pt2gap (+ gap (* 2 recl)));rectangle length * 2 (Plus the gap distance)
(setq pt3gap (polar pt2gap (/ pi 2) recw));get the new third point of rectangle


; Make a new rectangle that’s twice the length of the original (plus the gap)

(Command "line" pt1 pt2gap pt3gap pt4 pt1 "")


  ;Below not working:
        ;(entmake
            ;(list
               ;'(000 . "LWPOLYLINE")
               ;'(100 . "AcDbEntity")
               ;'(100 . "AcDbPolyline")
               ;'(090 . 4)
               ;'(070 . 1)
               ; (cons 010 pt1)
               ;(cons 010 pt2gap)
               ;(cons 010 pt3gap)
               ;(cons 010 pt4)
               ;(cons 210 z1)

            ;)
       ; )

;Delete first rectangle
(if (/= firstrec nil)(command "erase" firstrec ""))

    
);end Program

 

 

Any help is appreciated.

Thanks!

 

 

 

 

 

 

 

[mhupp]

Your only calculating a distance for pt2gap not a point. then feeding that into pt3gap and it error there.

You have  (polar distance angle distance) instead of (polar point angle distance)

 

Also their are 4 different ways to draw a rectangle so depending on what corner you start on pt 2 would be in a different location.

 

so using bounding box keeps the points in one orientation.

 

pt1 is always LL

pt3 is always UR

 

tho this means you can only use this on rectangles that use ortho and aren't on an angle.

 

(defun c:newrec (/ ent ptslst LL UR L&W len wid area pt1 pt2 pt3 pt4 gap lst)
  ;Draw a rectangle
  (vl-load-com)
  (command "_.rectang"
           (while (< 0 (getvar 'CMDACTIVE)) (command pause)) ;waits for user to complete command
  )
  (setq ent (entlast))  ;Save first rectangle
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
        ptslst (cons (vlax-safearray->list maxpt) ptslst)
  )
  (setq LL (apply 'mapcar (cons 'min ptslst))
        UR (apply 'mapcar (cons 'max ptslst))
        L&W (mapcar '- UR LL) ;gets length and width as a point from 0,0
  )
  (setq len (car L&W)   ; length of rectangle
        wid (cadr L&W)  ; width of rectangle
        area (* len wid)
        PT1 LL  ;reorders rectangle points so they are the same independent of how its drawn
        PT2 (list (car LL) (cadr UR))
        PT3 UR
  )
  (cond  ;use cond more here https://www.afralisp.net/autolisp/tutorials/cond-vs-if.php
    ((< area 40)
      (setq gap 4.0)
    )
    ((and (>= area 40) (< area 60))
      (setq gap 6.0)
    )
    ((and (>= area 60) (< area 80))
      (setq gap 8.0)
    )
    ((and (>= area 80) (< area 100))
      (setq gap 10.0)
    )
    ((>= area 100)
      (setq gap 12.0)
    )
  )
  ;Now find the total length. Two rectangles (plus the gap). width is stil the same "recw"
  (setq pt3 (polar pt2 (angle pt2 pt3) (+ gap (* 2 len))))  ;rectangle length * 2 (Plus the gap distance)
  (setq pt4 (polar pt3 (angle pt2 pt1) wid))  ;get the new third point of rectangle
  ;Make a new rectangle that’s twice the length of the original (plus the gap)
  ;(Command "line" pt1 pt2gap pt3gap pt4 pt1 "")
  (entmake (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 '(90 . 4)
                 '(70 . 1)
                 (cons 10 pt1)
                 (cons 10 pt2)
                 (cons 10 pt3)
                 (cons 10 pt4)
           )
  )
  (entdel ent)  ;Delete first rectangle
)

 

 

[RLispLearner]

Thanks. That works great! I also checked out the link and its very informative. I will have to practice more using conditionals rather than IFs.

[mhupp]

cond are more flexible then if's because it stops checking the statement and runs that code once its met. where the if's will check each one.

 

This means you can stack the testing and only have to test for the upper end at each step. this will do the same thing as what i posted earlier.

 

(cond  
  ((<= area 40) ;if area is 40 or less
    (setq gap 4.0)
  )
  ((<= area 60) ;if area is between 40 and 60
    (setq gap 6.0)
  )
  ((<= area 80)) ;if area is between 60 and 80
    (setq gap 8.0)
  )
  ((<= area 100)) ;if area is between 80 and 100
    (setq gap 10.0)
  )
  (t ;any number above 100
    (setq gap 12.0)
  )
)

 

[RLispLearner]

I’m trying to do something different with the working routine above.

-Create a small rectangle

- Copy to make a second small rectangle and place next to first (plus the gap size).

- Have both smaller rectangles showing (plus the overall larger rectangle)

 -Save all four corners of both rectangles to variables to use later.

 

First rectangle corner points saved:

firstboxpt1

firstboxpt2

firstboxpt3

firstboxpt4

 

Second rectangle corner points saved:

Secondboxpt1

Secondboxpt2

Secondboxpt3

Secondboxpt4

 

I have colored circles placed at all corner points of both rectangles to show that its working but they don’t show up.

Trying to look like this:

 

Im getting an error.

Can anyone see what Im doing wrong?

 

 

Here is my Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                                         
;;    -Create rectangle.                                           ;;
;;    -Get GAP size based on Area of rectangle               ;;
;;    -Create longer rectangle (x2) plus GAP                    ;;
;;    -Copy original rectangle over (plus the GAP size)            ;;
;;    -Save all corners of both orignal rectangles to variables    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:zzz (/ ent ent2 ptslst LL UR L&W len wid area pt1 pt2 pt3 pt4 gap lst firstboxpt1 firstboxpt2 firstboxpt3 firstboxpt4
 Secondboxpt1 Secondboxpt2 Secondboxpt3 Secondboxpt4)
  ;Draw a rectangle
  (vl-load-com)
(command "cecolor" 6);
  (command "_.rectang"
           (while (< 0 (getvar 'CMDACTIVE)) (command pause)) ;waits for user to complete command
  )
  (setq ent (entlast))  ;Save first rectangle
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
        ptslst (cons (vlax-safearray->list maxpt) ptslst)
  )
  (setq LL (apply 'mapcar (cons 'min ptslst))
        UR (apply 'mapcar (cons 'max ptslst))
        L&W (mapcar '- UR LL) ;gets length and width as a point from 0,0
  )
  (setq len (car L&W)   ; length of rectangle
        wid (cadr L&W)  ; width of rectangle
        area (* len wid)
        PT1 LL  ;reorders rectangle points so they are the same independent of how its drawn
        PT2 (list (car LL) (cadr UR))
        PT3 UR
  )

;Get corners of original rectangle 
(setq firstboxpt1 LL); lower left
(setq firstboxpt3 UR); upper right
(setq firstboxpt2 (list (car firstboxpt1) (cadr firstboxpt3))); upper left
(setq firstboxpt4 (list (car firstboxpt3) (cadr firstboxpt1))); lower right

;Set the GAP base on the rectangles AREA
  (cond  ;
    ((< area 40)
      (setq gap 4.0)
    )
    ((and (>= area 40) (< area 60))
      (setq gap 6.0)
    )
    ((and (>= area 60) (< area 80))
      (setq gap 8.0)
    )
    ((and (>= area 80) (< area 100))
      (setq gap 10.0)
    )
    ((>= area 100)
      (setq gap 12.0)
    )
  )
  ;Now find the total length. Two rectangles (plus the gap). width (height) is still the same "recw"
  (setq pt3 (polar pt2 (angle pt2 pt3) (+ gap (* 2 len))))  ;rectangle length * 2 (Plus the gap distance)
  (setq pt4a (polar pt3 (angle pt2 pt1) wid))  ;get the new third point of rectangle

  ;Make a new laonger rectangle that’s twice the length of the original (plus the gap)

  (entmake (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 '(90 . 4)
                 '(70 . 1)
                 (cons 10 pt1)
                 (cons 10 pt2)
                 (cons 10 pt3)
                 (cons 10 pt4a)
           )
  )


;Copy the first rectangle next to the original, plus the gap distance
(Command "copy" ent "" ur pt3); copy first rectangle start point (upper right) to new rectangle (upper right). Rec length plus gap.
(setq ent2 (entlast)); save second rectangle just copied

;Get corners for second rectangle (copied from original)
(setq Secondboxpt1 (+ LL (+ gap (* 2 len)))); lower left
(setq Secondboxpt3 (+ UR (+ gap (* 2 len)))); upper right
(setq Secondboxpt2 (list (car Secondboxpt1) (cadr Secondboxpt3))); upper left
(setq Secondboxpt4 (list (car Secondboxpt3) (cadr Secondboxpt1))); lower right

;Testing all the corner positions for both original rectangles. Put a circle at each corner of each rectangle.

(command "cecolor" 2);change color for circles
(command "circle" firstboxpt1 "d" 10 0 ""); create circle. diameter = 10
(command "_copy" "last" "" firstboxpt2 firstboxpt3 firstboxpt4 ""); copy circle to other corners of first rectangle

(command "cecolor" 4);;change color for circles
(command "circle" Secondboxpt1 "d" 10 0 ""); create circle. diameter = 10
(command "_copy" "last" "" Secondboxpt2 Secondboxpt3 Secondboxpt4 "")copy circle to other corners of second rectangle

  ;(entdel ent)  ;Delete original rectangle
);END

 

Any help is appreciated.

 

Thanks for all the help Mhupp!

[mhupp]

Your error is with calculating Second box points. you need to use polar to calculate the correct point.

But since drawing the circle's can be done in any order just use what you had in the first lisp to calculate their points.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;    -Create rectangle.                                           ;;
;;    -Get GAP size based on Area of rectangle                     ;;
;;    -Create longer rectangle (x2) plus GAP                       ;;
;;    -Copy original rectangle over (plus the GAP size)            ;;
;;    -Save all corners of both orignal rectangles to variables    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:zzz (/ drawing mspace ent ptslst LL UR L&W len wid area pt1 pt2 pt3 pt4 gap Fpt1 Fpt2 Fpt3 Fpt4 Spt1 Spt2 Spt3 Spt4)
  (vl-load-com)
  (setq drawing (vla-get-activedocument (vlax-get-acad-object))) ;needed for vlax-addcircle
  (setq mspace (vla-get-modelspace drawing)) ;needed for vlax-addcircle
  (setvar 'cecolor "6")  ;use setvar rather then command its faster and doesn't have and output to the command line.
  (command "_.rectang"
           (while (< 0 (getvar 'CMDACTIVE)) (command pause))  ;waits for user to complete command
  )
  (setq ent (entlast))         ;Save first rectangle
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
        ptslst (cons (vlax-safearray->list maxpt) ptslst)
  )
  (setq LL (apply 'mapcar (cons 'min ptslst))
        UR (apply 'mapcar (cons 'max ptslst))
        L&W (mapcar '- UR LL)  ;gets length and width as a point from 0,0
  )
  (setq len (car L&W)          ; length of rectangle
        wid (cadr L&W)         ; width of rectangle
        area (* len wid)
        PT1 LL                 ;reorders rectangle points so they are the same independent of how its drawn
        PT2 (list (car LL) (cadr UR))
        PT3 UR
  )
  ;Get corners of original rectangle 
  (setq Fpt1 (vlax-curve-getPointAtParam (entlast) 0)
        Fpt2 (vlax-curve-getPointAtParam (entlast) 1)
        Fpt3 (vlax-curve-getPointAtParam (entlast) 2)
        Fpt4 (vlax-curve-getPointAtParam (entlast) 3)
  )  ; setq
  ;Set the GAP base on the rectangles AREA
  (cond
    ((<= area 40)   ;if area is 40 or less
      (setq gap 4.0)
    )
    ((<= area 60)   ;if area is between 40 and 60
      (setq gap 6.0)
    )
    ((<= area 80)   ;if area is between 60 and 80
      (setq gap 8.0)
    )
    ((<= area 100)  ;if area is between 80 and 100
      (setq gap 10.0)
    )
    (t  ;if area is greater than 100
      (setq gap 12.0)
    )
  )
  ;Now find the total length. Two rectangles (plus the gap). width (height) is still the same "recw"
  (setq pt3 (polar pt2 (angle pt2 pt3) (+ gap (* 2 len))))  ;rectangle length * 2 (Plus the gap distance)
  (setq pt4 (polar pt3 (angle pt2 pt1) wid))  ;get the new third point of rectangle
  ;Make a new laonger rectangle that’s twice the length of the original (plus the gap)
  (entmake (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 '(90 . 4)
                 '(70 . 1)
                 (cons 10 pt1)
                 (cons 10 pt2)
                 (cons 10 pt3)
                 (cons 10 pt4)
           )
  )
  ;Copy the first rectangle next to the original, plus the gap distance
  (vla-move (vla-copy (vlax-ename->vla-object ent)) UR PT3)
  (setq Spt1 (vlax-curve-getPointAtParam (entlast) 0)
        Spt2 (vlax-curve-getPointAtParam (entlast) 1)
        Spt3 (vlax-curve-getPointAtParam (entlast) 2)
        Spt4 (vlax-curve-getPointAtParam (entlast) 3)
  )  ; setq
  ;Testing all the corner positions for both original rectangles. Put a circle at each corner of each rectangle.
  (setvar 'cecolor "2")          ;change color for circles
  (vla-addcircle mspace Fpt1 5)  ; create circle. radius = 5
  (vla-addcircle mspace Fpt2 5)  
  (vla-addcircle mspace Fpt3 5)  
  (vla-addcircle mspace Fpt4 5)  
  (setvar 'cecolor "4")          ;change color for circles
  (vla-addcircle mspace Spt1 5)  ; create circle. radius = 5
  (vla-addcircle mspace Spt2 5)  
  (vla-addcircle mspace Spt3 5)  
  (vla-addcircle mspace Spt4 5)  
  ;(entdel ent)  ;Delete original rectangle
)  ;END

 

 

Edited May 21, 2023 by mhupp

[RLispLearner]

I ran the code and can't seem to get it to work for me. I'm getting the following error at the command prompt.

 

Command: ZZZ
_.rectang
Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]:
Specify other corner point or [Area/Dimensions/Rotation]:
Command:
Command: ; error: lisp value has no coercion to VARIANT with this type:  (2854.41 1021.74 0.0)
Command: Regenerating model.

 

 

I put an Break on Error under Debug and ran last error and it  stopped at the following line.

(vla-move (vla-copy (vlax-ename->vla-object ent)) UR PT3)

 

 

 

I started commenting out sections of code to try and isolate where the issue was but only got more errors.

 

Did the routine work for you by chance? 

 

 

Thanks again for you help!

 

 

 

[mhupp]

Yes but I use BricsCAD so somethings are different. easiest fix would be to swap that line back out for this.

(Command "copy" ent "" ur pt3)