Jump to content

Autolisp: Issue with connecting all 6 points of a rectangle ( Four corner and two Mid points) with arc lines

RLispLearner

By RLispLearner
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

RLispLearner Contributor

RLispLearner

Posted
Posted

Hi all,

I am having issues connecting arc lines to 6 points on a rectangle (Four corner and two Mid points).

I have some great code from Lee mac that makes arc lines connecting four corner points of a rectangle. Works great  (Thanks Lee!).

I have now added mid points (for the longest side) to my rectangle and trying to add those two additions into my connection points for the arc lines.

I am missing something in my code to connect all 6 points. Can anyone see the issue by chance?  Getting weird results (Especially in a vertical rectangle).

Thanks in Advance!

(Thanks to Isaac26a and BigAl for their previous contributions as well)

 

 

Here is an image showing what I am hoping to achieve and what the current result is. Connection for corner Pt2 not working in this example.

 

Curved_lines_issue_03.thumb.PNG.02fc2278f36e08181912d1799ebabc97.PNG

 

 

 

Here is my code: 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points).        ;;;;
;;; Create arc lines connecting all 6 points.                                                     ;;;;
;;; Issue: Arcs not connecting to all 6 points.                                         ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:ArcLines (/ mylength mywidth oldecho pt1 pt2 pt3 pt4 pt5 pt6 p q)
  (vl-load-com)
  (setq oldecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq
    pt1 (getpoint "\nPick the first point")
    pt3 (getcorner "\Pick the next corner" pt1)
  )
  (vl-cmdf "_.rectang" pt1 pt3)
  (setq  pt2 (vlax-curve-getPointAtParam (entlast) 1)
         pt4 (vlax-curve-getPointAtParam (entlast) 3) 
  )
;Get length and width of rectangle
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)) ; width
;
;

;Find out which is the shorter side of the rectangle and then draw a line between the midpoints
  (if (> mywidth mylength); if mywidth is greather than mylength ( if true then...)
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))
    (setq pt6 (list (/ (+ (car pt2) (car pt3)) 2) (/ (+ (cadr pt2) (cadr pt3)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)
           ;; put the line on a layer
           '(8 . "MIDPOINTLINE")
           ;;color white
           '(62 . 7)
           )
    )

  );End Progn
   ; If its not true then...
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2)))
    (setq pt6 (list (/ (+ (car pt3) (car pt4)) 2) (/ (+ (cadr pt3) (cadr pt4)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)
           ;; put the line on a layer
           '(8 . "MIDPOINTLINE")
           ;;color white
           '(62 . 7)
           )
    )

  ) ;End Progn
  ) ;_ if


;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc. Set arc to 20
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 4)
               '(070 . 1)


                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 pt5); Pt5: Midpoint on one side
                (cons 042 (car b))


                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))


                (cons 010 pt6);Pt6: Midpoint on the other side
                (cons 042 (car b))

                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2 -Not working
                (cons 042 (cadr b))

                (cons 210 z)
            )
        )
    )


  (setvar 'cmdecho oldecho)
); End Program

 

 

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted (edited)

Have you tried your LWPolyline Ent Make Cons 90 to be 6 if you are drawing 6 arcs?

(Edit: I think there is a list out there somewhere what all the codes mean for each object type, for a polyline you need to say how many elements it has, in this case cons 90 does that)

 

I'd also put in an (entdel (entlast)) after you calculate Pt4 to remove the temporary? rectangle you draw

 

Last comment for you to look at, this works OK on my CAD machine on larger rectangles (say 100x75), but on a smaller rectangle (10 x 5) the arc is on the outside of the rectangle

Edited by Steven P
  • Like 1
Link to comment
Share on other sites
RLispLearner Contributor

RLispLearner

Posted
  • Author
Posted

Thanks Steven for your input. Sorry for the late reply.

I changed the Cons 90 from 4 to 6 and it worked! Although only for the horizontal rectangle in that particular sequence . I just need to change the sequence of points to make it work in the vertical (because the Mid points pt5 and pt6 are now on the opposite sides of the rectangle so results get weird). If I get both sequences working, I will move them under their respective sections of my Midpoints IF statements. They should work then if rectangle drawn horizontal or vertical... Hopefully🙂

 

Thanks for your help! If I get it all working, will post the final results for others who may be interested...

 

 

FYI:  This code is actually a snippet in a much larger routine I have. In that one I have a variable for the Area of the rectangle to control the arc so the arc changes proportionally with the size of the rectangle. I also delete the rectangle at the end as well. I just didn't want to bog down what I was posting with extra code...

 

Thanks again !

 

  • Like 1
Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)

I printed the coordinates of the points.  

You mistake which point is where.  

 

So I guess these lines of code at the beginning don't do what you think they do

  

  (setq  pt2 (vlax-curve-getPointAtParam (entlast) 1)
         pt4 (vlax-curve-getPointAtParam (entlast) 3) 
  )

 

image.png.a54e587cffa99fa37ff154374e1289b2.png

 

EDIT: It depends on how you draw the rectangle, anyway this doesn't fix anything when you swap p2 and p4

Edited by Emmanuel Delay
Link to comment
Share on other sites
RLispLearner Contributor

RLispLearner

Posted
  • Author
Posted

Thanks everyone. After changing the Cons 090 code from 4 to 6, everything worked correctly. I just had to then get the sequence right for the horizontal and the vertical layouts the user might draw. 

 

Horizontal sequence: 

        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 pt5); Pt5: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))

                (cons 010 pt6);Pt6: Midpoint on the other side
                (cons 042 (car b))

                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))


                (cons 210 z)
                (cons 48 scaledLtype);linetype scaling
            )

 

Vertical Sequence: 

        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 pt6); Pt6: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))


                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))

                (cons 010 pt5);Pt5: Midpoint on the other side
                (cons 042 (car b))


                (cons 210 z)
                (cons 48 scaledLtype);linetype scaling
            )

 

 

 

 

I added it to my original code and it all works great now. Here is a sample image of the end results after the code update:

 

User draws a 20' x 15' rectangle horizontally and then vertically:

Routine_Results.thumb.PNG.8413f8aa4cf6a9d0ee45495bc9997412.PNG

 

 

Thanks to everyone for your input!

 

 

  • Like 1
Link to comment
Share on other sites
RLispLearner Contributor

RLispLearner

Posted
  • Author
Posted

Yep. Its a "6 post Hip Roof Shade Structure" my employer fabricates in-house. I now have the workload for creating various sizes down to just two clicks! Glad to have it all working now... 🙂

 

Sorry if this a double post

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

I was thinking about this, interest for me that was all.

 

I woul;d have worked out all the points in order before the entmake polyline, something like below. This didn't need the temporary rectangle and I have changed the bulge calculation a bit so it works better with small rectangles (still gives odd results if the proportions width - height are very long and narrow)

 

 

Anyway, I was intrigued how to make it up using my thinking, and pasted below as another example of this

  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points).        ;;;;
;;; Create arc lines connecting all 6 points.                                                                            ;;;;
;;; Issue: Arcs not connecting to all 6 points.                                                                          ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:ArcLines (/ oldecho spt1 spt2 spt3 spt4 scpt1 scpt2 a b c d z)
  (vl-load-com)
  (setq oldecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq
    spt1 (getpoint "\nPick the first point")
    spt3 (getcorner "\Pick the next corner" spt1)
    a (if (< (car spt1)(car spt3))(car spt1)(car spt3)) ;;Lower Left X coord
    b (if (> (car spt1)(car spt3))(car spt1)(car spt3)) ;;Upper Right X coord
    c (if (< (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Lower Left y Coord
    d (if (> (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Upper Right Y Coord
    z (if (caddr spt1)(caddr spt1) 0) ;;Z Coord
  )

  ;;Make points
  (if (> (abs (- a b)) (abs (- c d)))
    ;;IF width > length
    (progn
      (setq spt2 (list a c z))
      (setq spt3 (list b c z))
      (setq spt4 (list b d z))
      (setq spt1 (list a d z))
    ) ;end progn
    ;;IF length > width
    (progn
      (setq spt1 (list a c z))
      (setq spt2 (list b c z))
      (setq spt3 (list b d z))
      (setq spt4 (list a d z))
    );end progn
  ) ; end if

  ;;center points
  (setq
    scpt1 (list (/ (+ (car spt2) (car spt3)) 2) (/ (+ (cadr spt2) (cadr spt3)) 2))
    scpt2 (list (/ (+ (car spt1) (car spt4)) 2) (/ (+ (cadr spt1) (cadr spt4)) 2))
  )

  ;;Draw Centre Line
  (entmake (list '(0 . "LINE")
           (cons 10 scpt1)
           (cons 11 scpt2)
           '(8 . "MIDPOINTLINE") ;layer
           '(62 . 7) ; colour
           ) ;end list
  ) ;end entmake

  (setq arclines ( / (abs (- c d)) 10) )
  (if (and (setq b (list (/ arclines (- a b) 0.5) (/ arclines (- c d) 0.5))) )
    (entmake
      (list
        '(000 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(090 . 6)
        '(070 . 1)

        (cons 10 spt1)
        (cons 42 (car b))
        (cons 10 spt2)
        (cons 42 (car b))
        (cons 10 scpt1)
        (cons 42 (car b))
        (cons 10 spt3)
        (cons 42 (car b))
        (cons 10 spt4)
        (cons 42 (car b))
        (cons 10 scpt2)
        (cons 42 (car b))

        (cons 210 (list 0 0 z))
      )
    )
  ) ;END IF

  (setvar 'cmdecho oldecho)
  (princ)
); End Program

 

  • Like 1
Link to comment
Share on other sites
  • 2 weeks later...
RLispLearner Contributor

RLispLearner

Posted
  • Author
Posted

Hi All,

Code works from left to right but not right to left because my code doesn't account for that scenario. Just wondering if there is a better way instead of writing more code to cover whichever way the user draws the rectangle for it to work.

The User's two picked points are point pt1 and point pt3.

 

 

Curved_lines_Left_to_right.thumb.PNG.c31a8ef2c45a59c1a886dce0efe86dad.PNG

 

 

 

 

 If I draw rectangle in the opposite direction the arc becomes crisscrossed because I haven't written code to cover new point layout.  I can solve this issue by doubling the code to account for drawing rectangle from right to left but wondering if there is a more simplistic wat to account for any direction the user draws rectangle.

 

Curved_lines_right_to_left.thumb.PNG.b638e5b59f9490913ee069f3ec2716c5.PNG

 

 

NOTE: For now, I substituted my original variable of the rectangle size to control arc amount with an arbitrary number of 20 (just to keep the code smaller).

 

 

My Code that works from left to right. 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points).        ;;;;
;;; Create arc lines connecting all 6 points.                                                     ;;;;
;;;                                                             ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:arctest (/ mylength mywidth oldecho pt1 pt2 pt3 pt4 pt5 pt6 p q)
  (vl-load-com)
  (setq oldecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq
    pt1 (getpoint "\nPick the first point")
    pt3 (getcorner "\Pick the next corner" pt1)
  )
  (vl-cmdf "_.rectang" pt1 pt3)
  (setq  pt2 (vlax-curve-getPointAtParam (entlast) 1)
         pt4 (vlax-curve-getPointAtParam (entlast) 3) 
  )

(setq delete_rec (cdr(assoc -1(entget (entlast)))))

;Get length and width of rectangle
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)) ; width
;
;

;Find out which is the shorter side of the rectangle and then draw a line between the midpoints
  (if (> mywidth mylength); if mywidth is greather than mylength ( if true then...)
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))
    (setq pt6 (list (/ (+ (car pt2) (car pt3)) 2) (/ (+ (cadr pt2) (cadr pt3)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )

;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Vertical arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 pt6); Pt6: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))


                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))

                (cons 010 pt5);Pt5: Midpoint on the other side
                (cons 042 (car b))


                (cons 210 z)
            )
        )
    );END Vertical  arc setup

  (setvar "PLINEWID" 0)


  );End Progn
   ; If its not true then...
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2)))
    (setq pt6 (list (/ (+ (car pt3) (car pt4)) 2) (/ (+ (cadr pt3) (cadr pt4)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )


;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Horizontal arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 pt5); Pt5: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))

                (cons 010 pt6);Pt6: Midpoint on the other side
                (cons 042 (car b))

                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))


                (cons 210 z)
            )
        )
    );END Horizontal arc setup


  (setvar "PLINEWID" 0)

  ) ;End Progn
  ) ;_ if

(if (/= delete_rec nil)(command "erase" delete_rec ""))

  (setvar 'cmdecho oldecho)
); End Program

 

 

Thanks in advance...!

 

 

Link to comment
Share on other sites
exceed Proficient

exceed

Posted
Posted (edited)
24 minutes ago, RLispLearner said:

Hi All,

Code works from left to right but not right to left because my code doesn't account for that scenario. Just wondering if there is a better way instead of writing more code to cover whichever way the user draws the rectangle for it to work.

The User's two picked points are point pt1 and point pt3.

 

 

Curved_lines_Left_to_right.thumb.PNG.c31a8ef2c45a59c1a886dce0efe86dad.PNG

 

 

 

 

 If I draw rectangle in the opposite direction the arc becomes crisscrossed because I haven't written code to cover new point layout.  I can solve this issue by doubling the code to account for drawing rectangle from right to left but wondering if there is a more simplistic wat to account for any direction the user draws rectangle.

 

Curved_lines_right_to_left.thumb.PNG.b638e5b59f9490913ee069f3ec2716c5.PNG

 

 

NOTE: For now, I substituted my original variable of the rectangle size to control arc amount with an arbitrary number of 20 (just to keep the code smaller).

 

 

My Code that works from left to right. 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points).        ;;;;
;;; Create arc lines connecting all 6 points.                                                     ;;;;
;;;                                                             ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:arctest (/ mylength mywidth oldecho pt1 pt2 pt3 pt4 pt5 pt6 p q)
  (vl-load-com)
  (setq oldecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq
    pt1 (getpoint "\nPick the first point")
    pt3 (getcorner "\Pick the next corner" pt1)
  )
  (vl-cmdf "_.rectang" pt1 pt3)
  (setq  pt2 (vlax-curve-getPointAtParam (entlast) 1)
         pt4 (vlax-curve-getPointAtParam (entlast) 3) 
  )

(setq delete_rec (cdr(assoc -1(entget (entlast)))))

;Get length and width of rectangle
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)) ; width
;
;

;Find out which is the shorter side of the rectangle and then draw a line between the midpoints
  (if (> mywidth mylength); if mywidth is greather than mylength ( if true then...)
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))
    (setq pt6 (list (/ (+ (car pt2) (car pt3)) 2) (/ (+ (cadr pt2) (cadr pt3)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )

;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Vertical arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 pt6); Pt6: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))


                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))

                (cons 010 pt5);Pt5: Midpoint on the other side
                (cons 042 (car b))


                (cons 210 z)
            )
        )
    );END Vertical  arc setup

  (setvar "PLINEWID" 0)


  );End Progn
   ; If its not true then...
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2)))
    (setq pt6 (list (/ (+ (car pt3) (car pt4)) 2) (/ (+ (cadr pt3) (cadr pt4)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )


;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Horizontal arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 pt5); Pt5: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))

                (cons 010 pt6);Pt6: Midpoint on the other side
                (cons 042 (car b))

                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))


                (cons 210 z)
            )
        )
    );END Horizontal arc setup


  (setvar "PLINEWID" 0)

  ) ;End Progn
  ) ;_ if

(if (/= delete_rec nil)(command "erase" delete_rec ""))

  (setvar 'cmdecho oldecho)
); End Program

 

 

Thanks in advance...!

 

 

 

 

arctest.gif

 

TRY THIS

  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create a rectangle (4 corner points). Draw a midpoint line on the longest side of a rectangle (2 mid points).        ;;;;
;;; Create arc lines connecting all 6 points.                                                     ;;;;
;;;                                                             ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:arctest (/ mylength mywidth oldecho pt1 pt2 pt3 pt4 pt5 pt6 p q pt1x pt1y pt3x pt3y pt1ax pt3ax pt1ay pt3ay )
  (vl-load-com)
  (setq oldecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq
    pt1 (getpoint "\nPick the first point")
    pt3 (getcorner "\Pick the next corner" pt1)
  )
  (setq pt1x (car pt1))
  (setq pt1y (cadr pt1))
  (setq pt3x (car pt3))
  (setq pt3y (cadr pt3))

  (cond
    ((<= pt1x pt3x) (setq pt1ax pt1x) (setq pt3ax pt3x))
    ((> pt1x pt3x) (setq pt1ax pt3x) (setq pt3ax pt1x))
  )
  (cond
    ((<= pt1y pt3y) (setq pt1ay pt1y) (setq pt3ay pt3y))
    ((> pt1y pt3y) (setq pt1ay pt3y) (setq pt3ay pt1y))
  )
  (setq pt1 (list pt1ax pt1ay (caddr pt1)))
  (setq pt3 (list pt3ax pt3ay (caddr pt3)))

  (vl-cmdf "_.rectang" pt1 pt3)
  (setq  pt2 (vlax-curve-getPointAtParam (entlast) 1)
         pt4 (vlax-curve-getPointAtParam (entlast) 3) 
  )

(setq delete_rec (cdr(assoc -1(entget (entlast)))))

;Get length and width of rectangle
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)) ; width
;
;

;Find out which is the shorter side of the rectangle and then draw a line between the midpoints
  (if (> mywidth mylength); if mywidth is greather than mylength ( if true then...)
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))
    (setq pt6 (list (/ (+ (car pt2) (car pt3)) 2) (/ (+ (cadr pt2) (cadr pt3)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )

;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Vertical arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 pt6); Pt6: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))


                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))

                (cons 010 pt5);Pt5: Midpoint on the other side
                (cons 042 (car b))


                (cons 210 z)
            )
        )
    );END Vertical  arc setup

  (setvar "PLINEWID" 0)


  );End Progn
   ; If its not true then...
  (progn
    (setq pt5 (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2)))
    (setq pt6 (list (/ (+ (car pt3) (car pt4)) 2) (/ (+ (cadr pt3) (cadr pt4)) 2)))
    (entmake (list '(0 . "LINE")
           (cons 10 pt5)
           (cons 11 pt6)

           )
    )


;*****************************************************************************************************
;Connect all 6 points ( 4 corners and 2 midpoints) by arc lines
;****************************************************************************************************
;Horizontal arc setup

    (setq arclines 20) ;; Arc sagitta- midpoint of the chord to the midpoint of the arc
    
    (if (and (setq p pt1)
             (setq q pt3)
             (mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
             (setq z (trans '(0 0 1) 1 0 t)
                   b (mapcar '(lambda ( a b c ) (/ arclines (- a b) -0.5)) q p '(0 0))
             )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 6)
               '(070 . 1)

                (cons 010 (trans p 1 z)); Pt1
                (cons 042 (car b))

                (cons 010 pt5); Pt5: Midpoint on one side
                (cons 042 (car b))

                (cons 010 (trans (list (car q) (cadr p)) 1 z)); Pt4
                (cons 042 (cadr b))

                (cons 010 (trans q 1 z));Pt3
                (cons 042 (car b))

                (cons 010 pt6);Pt6: Midpoint on the other side
                (cons 042 (car b))

                (cons 010 (trans (list (car p) (cadr q)) 1 z));Pt2
                (cons 042 (cadr b))


                (cons 210 z)
            )
        )
    );END Horizontal arc setup


  (setvar "PLINEWID" 0)

  ) ;End Progn
  ) ;_ if

(if (/= delete_rec nil)(command "erase" delete_rec ""))

  (setvar 'cmdecho oldecho)
); End Program
Edited by exceed
  • Like 1
Link to comment
Share on other sites
RLispLearner Contributor

RLispLearner

Posted
  • Author
Posted

Sorry Steven P  I misunderstood your previous post with the answer. And thank you Exceed for your input as well. It works great!

 

If I understand, get the X and Y value of a point so you know the direction. Make conditional statement and reassign the version needed back to the original variable based on that direction. Then  move forward.. Hope I'm in the ballpark (Or at least the parking lot.) 😀

 

Thanks again everyone! 

  • Like 1
Link to comment
Share on other sites
  • 1 month later...
marko_ribar Veteran

marko_ribar

Posted
Posted

May I ask,

What is this useful for?

Have you perhaps heard for MPanel - Melier...

I suppose you are seeking for some sort of tensile cable / membrane construction, or perhaps for something like flag amblems, or perhaps avatar signature, or simple fun task, or...?

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted
1 hour ago, marko_ribar said:

May I ask,

What is this useful for?

Have you perhaps heard for MPanel - Melier...

I suppose you are seeking for some sort of tensile cable / membrane construction, or perhaps for something like flag amblems, or perhaps avatar signature, or simple fun task, or...?

 

 

 

"Yep. Its a "6 post Hip Roof Shade Structure" my employer fabricates in-house."

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.

×
 Share
Go to topic listing
×
×
  • Create New...