Create Sausage shape with ARC offset

June 11, 2021

Hi,

I was wondering if it is possible to create a closed polyline which exists of 2 offsettet Arcs and closed endcaps with circles
The shape looks like a saucage (I have attached a picture).
The input would be:
1. Select base point (which is always 0,0)
2. Select the 4 red Circles
3. Enter the Angle (e.g. 15 degrees)

Note: the Location of the 4 red circles may be shifted in Y-direction, but the base point stays 0,0

June 11, 2021

YES ! Have a go its the best way to learn. This is a good exercise example fairly straight forward.

Write down the steps then convert to lisp.

enter angle

Pick centre pt

while

pick circle get centre and radius

do some point calcs for start end of arc.

arc start end 1/2 rad

fillet rad 0 startptarc1 startpt2 1/2rad

offset rad

endwhile

Hints

for circle (entget (car (entsel "\npick circle .....) look at (cdr (assoc 10 & (cdr (assoc 40

For start end points need to use (polar cen ang dist) +- 1/2angle of the angle from centre point to center of circle

Edited June 11, 2021 by BIGAL

June 14, 2021

Thanx for the hints, I'll try

June 14, 2021

Just want to say that this is not so easy task...

June 14, 2021

Just following the topic

June 15, 2021

(defun c:MontyPytonsFlyingSausages
  ;;; variable declarations
  ( / ss angle-degrees point-zero angle-radians circ-ent circ-el circ-cen circ-rad circ-dist
      circ-ang inside-arc-dist outside-arc-dist inside-arc-LR outside-arc-UL ss->el)
  (defun ss->el (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  ;;; main routine
  (if (and (setq ss (ssget '((0 . "CIRCLE")))) (setq angle-degrees (getreal "\nEnter angle offset : "))
           (setq point-zero '(0.0 0.0 0.0)) (setq angle-radians (* pi (/ angle-degrees 180.0))))
    (foreach circ-ent (ss->el ss)
      ;;; get circle elist
      (setq circ-el (entget circ-ent))
      ;;; get circle center point
      (setq circ-cen (cdr (assoc 10 circ-el)))
      ;;; get circle radius
      (setq circ-rad (cdr (assoc 40 circ-el)))
      ;;; get angle & distance from 0,0 to circle center
      (setq circ-dist (distance point-zero circ-cen))
      ;;; get angle between point-zero and circle (radians)
      (setq circ-ang (angle point-zero circ-cen))
      ;;; compute distances for inside & outside arc
      (setq inside-arc-dist (- circ-dist circ-rad) outside-arc-dist (+ circ-dist circ-rad))
      ;;; compute all arc-points (clockwise)
      (setq inside-arc-LR (polar point-zero (- circ-ang angle-radians) inside-arc-dist))
      ;;; compute all arc-points (clockwise)
      (setq outside-arc-UL (polar point-zero (+ circ-ang angle-radians) outside-arc-dist))
      ;;; draw pline
      (command ".pline" outside-arc-UL "arc" "CE" point-zero "ang" (- 0 (* angle-degrees 2.0))
               inside-arc-LR "CE" point-zero "ang" (* angle-degrees 2.0) "close" )    
    )
  )
)

;;; shortcut
(defun c:t1 ()(c:MontyPytonsFlyingSausages))

J4F (just for fun)

June 15, 2021

Nice one rlx!

I like how you use the pline center and ang functions so you don't have to calculate all the points.

When I was trying the code I did have some problems with snap.

So for gsc: if you replace the last line with this, you wont have those problems.

(command ".pline" "_none" outside-arc-UL "arc" "CE" "_none" point-zero "ang" (- 0 (* angle-degrees 2.0))
         "_none" inside-arc-LR "CE" "_none" point-zero "ang" (* angle-degrees 2.0) "close" )

June 15, 2021

This one is a bit long winded but works as well - this follows how I would make the sausages up manually.

I am putting this here because I added a check that the angle isn't greater than 360 degrees (probably should be less than that) and added a line if needed to select the centre point.

I did most of this yesterday before rlx posted his solution - otherwise I would use his, his looks nicer.

(vl-load-com)
(defun c:sausageshape( / acount sscircle myangle centrepoint centre2 redius2 circle1 circle3 centre1 centre3 centrearc lowerarc upperarc arc3s arc1e end1 end2)

  (setq acount 0)
  (setq sscircle (ssget '((0 . "CIRCLE"))))
  (setq myangle (getreal "\nEnter Angle "))
  (if ( >= myangle 360)(princ "Angle Too Large")
    (progn
  (Setq centrepoint "0,0,0")
;-;  (setq centrepoint (getpoint "Select centre point")) ;-; if needed

;;loop
  (while (< acount (sslength sscircle) )
;;get points for end arcs
    (command "rotate" (ssname sscircle acount) "" centrepoint "copy" (/ myangle 2) )
    (setq centre1 (cdr (assoc 10 (entget(entlast)))))
    (entdel (entlast))
    (setq centre2 (cdr (assoc 10 (entget (ssname sscircle acount)) )))
    (setq radius2 (cdr (assoc 40 (entget (ssname sscircle acount)) )))
    (command "rotate" (ssname sscircle acount) "" centrepoint "copy" (/ myangle -2) )
    (setq centre3 (cdr (assoc 10 (entget(entlast)))))
    (entdel(entlast))

;;Make Arcs
    (command "arc" centre1 centre2 centre3)
    (setq centrearc (entlast))
    (command "offset" radius2 centrearc centrepoint "")
    (setq lowerarc (entlast))
    (command "offset" (* radius2 2) lowerarc centre2 "")
    (setq upperarc (entlast))
    (setq arc1e (vlax-curve-getEndPoint upperarc) )
    (setq arc3s (vlax-curve-getStartPoint lowerarc) )
    (command "_pline" arc3s "arc" "ce" centre3 "a" 180 "")
    (setq end1 (entlast))
    (command "_pline" arc1e "arc" "ce" centre1 "a" 180 "")
    (setq end2 (entlast))

;;join arcs
    (command "join" end1 upperarc end2 lowerarc "")
    (entdel centrearc)

    (setq acount (+ 1 acount))
  ) ;end while

    );end progn
  );end if
  (princ)
)

June 15, 2021

my other way to skin a a cat .

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2021 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;

 ; Hecho por  Gabo CALOS DE VIT de CORDOBA ARGENTINA
;;;    Copyleft 1995-2021 por Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM 


;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;;Copyright ©2005 - Marc'Antonio Alessi, Italy - All rights reserved-01
;; http://xoomer.virgilio.it/alessi
(DEFUN ALE_ENTSELFILTER  (PRMSTR FLTLST / FLGSLT ENTNAM)
  (SETVAR "ERRNO" 0)
  (PRINC "\n_ ")
  (PROMPT (SETQ PRMSTR (STRCAT "\n" PRMSTR ": ")))
  (IF
    (WHILE (NOT FLGSLT)
      (IF (SETQ ENTNAM (SSGET "_:E:S" FLTLST))
        (NOT (SETQ FLGSLT T))
        (IF (= 52 (GETVAR "ERRNO"))
          (SETQ FLGSLT T)
          (ALERT
            ;;(STRCAT "\nUd no entendió lo que le pedí, pruebe de nuevo!" PRMSTR)
            (strcat "\nYou did not understood what I ask for , try it again!"   PrmStr)
            )
          ) ;_if 
        ) ;_if
      ) ;_while
     (NOT (PRINC "\nFunction cancelled. "))
     (SSNAME ENTNAM 0)
     ) ;_if
  ) ;_defun
;;usage
;;(ALE_EntSelFilter "Seleccione la poly del terreno" '((0 . "POLYLINE") (100 . "AcDb3dPolyline")))

 ;********************************************************************************************************************






(DEFUN &-LAY-CO/NAME-COLOR  (LAYER-NAME
                             COLOR
                             /
                             )
  (IF (= COLOR NIL)
    (SETQ COLOR 256)
    )
  (IF (TBLSEARCH "LAYER" LAYER-NAME)
    (PROGN
      (SETQ LAY-NEW (VLA-ITEM LAY-COLL LAYER-NAME))
      (IF (= (VLA-GET-FREEZE LAY-NEW) :VLAX-FALSE)
        (PRINC)
        (VLA-PUT-FREEZE LAY-NEW :VLAX-FALSE)
        )
      (VLA-PUT-LAYERON LAY-NEW :VLAX-TRUE)
      (VLA-PUT-COLOR LAY-NEW COLOR)
      (VLA-PUT-ACTIVELAYER ADOC LAY-NEW)
      (VLA-ITEM LAY-COLL LAYER-NAME)
      ) ;_ progn si existe , y la descongela y la prende
    (PROGN
      (SETQ LAY-NEW (VLA-ADD LAY-COLL LAYER-NAME))
      (VLA-PUT-ACTIVELAYER ADOC LAY-NEW)
      (VLA-PUT-COLOR LAY-NEW COLOR)

      LAY-NEW
      ) ;Progn si no existe
    ) ;_ controla si existe la capa 
  )
 ;************************************************************************************************************
;;-*******************************************************************************************************************************

(DEFUN TIME-INI  ()
  (SETQ INI@ (GETVAR "millisecs"))
  )

(DEFUN TIME-FIN  ()
  (SETQ FIN@ (GETVAR "millisecs"))
  (SETQ TIEMPO-INI-FIN (/ (- FIN@ INI@) 1000.0))
  )
;;******************************************************  
;;RAD TO DEG AND DEG TO RAD
(DEFUN RTD  (X) ;_define  RADIAN  TO DEGREE function
  (/ (* X 180.0) PI)
  )
;; MULTIPLY THE RAD ING BY 180  AND DIVIDE IT BY PI
(DEFUN DTR  (X) ;_define DEGREE to RADIAN function
  (/ (* X PI) 180.0)
  ) ;_end dtr rtd
;;MULTIPLY THE  DGR ING BY PI  AND DIVIDE IT BY 180
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*



;;************************************************************




(DEFUN MAKE-SAUSAGES  (/
                       <-ARC
                       >-ARC
                       ACAD-OBJ
                       ADOC
                       ALL-RED-CIRCLES-OBJ-SS
                       ANGDIR
                       ANGLE-TO-SWEP
                       ANGLE<
                       ANGLE<>
                       ANGLE>
                       ARC<CENTER
                       ARC<END-ANGLE
                       ARC<ST-ANGLE
                       ARC>CENTER
                       ARC>END-ANGLE
                       ARC>ST-ANGLE
                       BIG-ARC
                       BIG-RADIUS
                       BLOCK-COLL
                       CLAYER
                       DIST-FROM-URIG
                       HALF-RADIUS
                       INI-TIME
                       LAY-COLL
                       MODEL
                       P1
                       P2
                       P3
                       P4
                       RED-CIRCLE-CENTER-VAR
                       RED-CIRCLE-CENTER-XYZ
                       RED-CIRCLE-OBJ
                       RED-CIRCLE-OBJ-DIAMETER
                       RED-CIRCLE-OBJ-LAY
                       RED-CIRCLE-OBJ-RADIUS
                       RED-CIRCLE-SAMPLE
                       SELECTIONSETS
                       SLOT-ARC-SS
                       SMALL-ARC
                       SMALL-RADIUS
                       URIG
                       URIG-TO-CENTER-ANGLE
                       URIG-VAR

                       )
  ;;********************************************************************************************************
  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT))
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ))
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  (SETQ SELECTIONSETS (VLA-GET-SELECTIONSETS ADOC))
  (SETQ BLOCK-COLL (VLA-GET-BLOCKS ADOC))
  (SETQ LAY-COLL (VLA-GET-LAYERS ADOC))

  (VLAX-FOR LAYER  LAY-COLL
    (IF (NOT (= (VLA-GET-NAME LAYER) (GETVAR 'CLAYER)))
      (VLA-PUT-FREEZE LAYER :VLAX-FALSE)
      )
    )
  (SETVAR 'CLAYER "0")



  (SETQ RED-CIRCLE-SAMPLE (ALE_ENTSELFILTER "select one red circle "
                                            '((0 . "CIRCLE"))))
  (SETQ RED-CIRCLE-OBJ (VLAX-ENAME->VLA-OBJECT RED-CIRCLE-SAMPLE))
  (SETQ RED-CIRCLE-OBJ-LAY (VLA-GET-LAYER RED-CIRCLE-OBJ))

  (SETQ CLAYER (GETVAR 'CLAYER))
  (&-LAY-CO/NAME-COLOR "sausage-slot" ACBLUE)
  (SETVAR 'CLAYER CLAYER)
  (SSGET "X" (LIST (CONS 0 "circle") (CONS 8 RED-CIRCLE-OBJ-LAY)))

  (SETQ ALL-RED-CIRCLES-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))



  (SETQ ANGLE-TO-SWEP (DTR 15))


  (SETQ URIG (LIST 0 0 0))
  (SETQ URIG-VAR (VLAX-3D-POINT URIG))
  (SETQ INI-TIME (TIME-INI))


  (VLAX-FOR RED-CIRCLE-OBJ  ALL-RED-CIRCLES-OBJ-SS
;;;      (setq red-circle-obj (VLA-ITEM all-red-circles-obj-ss 2))
    (SETQ RED-CIRCLE-CENTER-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-CENTER RED-CIRCLE-OBJ))))
    (SETQ RED-CIRCLE-CENTER-VAR (VLA-GET-CENTER RED-CIRCLE-OBJ))
    (SETQ RED-CIRCLE-OBJ-RADIUS (VLA-GET-RADIUS RED-CIRCLE-OBJ))
    (SETQ RED-CIRCLE-OBJ-DIAMETER (* 2.0 RED-CIRCLE-OBJ-RADIUS))
    (SETQ DIST-FROM-URIG (DISTANCE URIG RED-CIRCLE-CENTER-XYZ))
    (SETQ URIG-TO-CENTER-ANGLE (ANGLE URIG RED-CIRCLE-CENTER-XYZ))
    (SETQ ANGDIR (GETVAR 'ANGDIR)) ; 0 for CCW , 1 for CW 
    (SETVAR 'ANGDIR 0)

    (SETQ SMALL-RADIUS (- DIST-FROM-URIG RED-CIRCLE-OBJ-RADIUS))
    (SETQ BIG-RADIUS (+ DIST-FROM-URIG RED-CIRCLE-OBJ-RADIUS))
    (SETQ HALF-RADIUS DIST-FROM-URIG)
    (SETQ ANGLE< (- URIG-TO-CENTER-ANGLE ANGLE-TO-SWEP))
    (SETQ ANGLE<> URIG-TO-CENTER-ANGLE)
    (SETQ ANGLE> (+ URIG-TO-CENTER-ANGLE ANGLE-TO-SWEP))


    (SETQ P1 (POLAR URIG ANGLE< SMALL-RADIUS))
    (SETQ P2 (POLAR URIG ANGLE< BIG-RADIUS))

    (SETQ P3 (POLAR URIG ANGLE> SMALL-RADIUS))
    (SETQ P4 (POLAR URIG ANGLE> BIG-RADIUS))


    (SETQ SMALL-ARC (VLA-ADDARC MODEL (VLAX-3D-POINT URIG) SMALL-RADIUS ANGLE< ANGLE>))
    (VLA-PUT-LAYER SMALL-ARC "sausage-slot")
    (SETQ BIG-ARC (VLA-ADDARC MODEL (VLAX-3D-POINT URIG) BIG-RADIUS ANGLE< ANGLE>))
    (VLA-PUT-LAYER BIG-ARC "sausage-slot")
    (SETQ ARC<CENTER (POLAR URIG ANGLE< HALF-RADIUS))
    (SETQ ARC>CENTER (POLAR URIG ANGLE> HALF-RADIUS))

    (SETQ ARC<ST-ANGLE (ANGLE ARC<CENTER P1))
    (SETQ ARC<END-ANGLE (ANGLE ARC<CENTER P2))

    (SETQ ARC>ST-ANGLE (ANGLE ARC>CENTER P4))
    (SETQ ARC>END-ANGLE (ANGLE ARC>CENTER P3))

    (SETQ <-ARC (VLA-ADDARC MODEL (VLAX-3D-POINT ARC<CENTER) RED-CIRCLE-OBJ-RADIUS ARC<ST-ANGLE ARC<END-ANGLE))
    (VLA-PUT-LAYER <-ARC "sausage-slot")

    (SETQ >-ARC (VLA-ADDARC MODEL (VLAX-3D-POINT ARC>CENTER) RED-CIRCLE-OBJ-RADIUS ARC>ST-ANGLE ARC>END-ANGLE))


    (VLA-PUT-LAYER >-ARC "sausage-slot")

    (SETQ CLAYER (GETVAR 'CLAYER))

    (SETVAR 'CLAYER "sausage-slot")
    (VLAX-FOR LAYER  LAY-COLL
      (IF (NOT (= (VLA-GET-NAME LAYER) (GETVAR 'CLAYER)))
        (VLA-PUT-FREEZE LAYER :VLAX-TRUE)
        )
      )



    (SETQ SLOT-ARC-SS (SSGET "X" '((0 . "arc") (8 . "sausage-slot"))))


 ;(VL-CMDF "_.pedit" "m" SLOT-ARC-SS "" "j" "" "")
    (INITCOMMANDVERSION) ; [because otherwise, in (command) function, doesn't work quite as doing manually]

    (COMMAND "_.join" SLOT-ARC-SS "")



    ) ;end  VLAX-FOR
  (VLAX-FOR LAYER  LAY-COLL
    (IF (NOT (= (VLA-GET-NAME LAYER) (GETVAR 'CLAYER)))
      (VLA-PUT-FREEZE LAYER :VLAX-FALSE)
      )
    )
  (SETVAR 'CLAYER "0")

  (INITCOMMANDVERSION) ; [because otherwise, in (command) function, doesn't work quite as doing manually]
  (COMMAND "regen")



  (TIME-FIN)

  ) ; end DEFUN



 ; end VLAX-FOR 
(ALERT (STRCAT "it last just "
               (RTOS END-TIME)
               "   seconds  to do "
               (ITOA (VLA-GET-COUNT ALL-RED-CIRCLES-OBJ-SS))
               "  sausages SLOTS"))



(DEFUN C:SLOTS  ()
  (MAKE-SAUSAGES)
  )

;|«Visual LISP© Format Options»
(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

make-sausages.lsp 10 sausages.dwg

June 18, 2021

On 6/15/2021 at 8:21 AM, rlx said:


(defun c:MontyPytonsFlyingSausages
  ;;; variable declarations
  ( / ss angle-degrees point-zero angle-radians circ-ent circ-el circ-cen circ-rad circ-dist
      circ-ang inside-arc-dist outside-arc-dist inside-arc-LR outside-arc-UL ss->el)
  (defun ss->el (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  ;;; main routine
  (if (and (setq ss (ssget '((0 . "CIRCLE")))) (setq angle-degrees (getreal "\nEnter angle offset : "))
           (setq point-zero '(0.0 0.0 0.0)) (setq angle-radians (* pi (/ angle-degrees 180.0))))
    (foreach circ-ent (ss->el ss)
      ;;; get circle elist
      (setq circ-el (entget circ-ent))
      ;;; get circle center point
      (setq circ-cen (cdr (assoc 10 circ-el)))
      ;;; get circle radius
      (setq circ-rad (cdr (assoc 40 circ-el)))
      ;;; get angle & distance from 0,0 to circle center
      (setq circ-dist (distance point-zero circ-cen))
      ;;; get angle between point-zero and circle (radians)
      (setq circ-ang (angle point-zero circ-cen))
      ;;; compute distances for inside & outside arc
      (setq inside-arc-dist (- circ-dist circ-rad) outside-arc-dist (+ circ-dist circ-rad))
      ;;; compute all arc-points (clockwise)
      (setq inside-arc-LR (polar point-zero (- circ-ang angle-radians) inside-arc-dist))
      ;;; compute all arc-points (clockwise)
      (setq outside-arc-UL (polar point-zero (+ circ-ang angle-radians) outside-arc-dist))
      ;;; draw pline
      (command ".pline" outside-arc-UL "arc" "CE" point-zero "ang" (- 0 (* angle-degrees 2.0))
               inside-arc-LR "CE" point-zero "ang" (* angle-degrees 2.0) "close" )    
    )
  )
)

;;; shortcut
(defun c:t1 ()(c:MontyPytonsFlyingSausages))

J4F (just for fun)

Hahahaha...You're working at the ministry of funny lisps, I guess?
Working great though...Thanx!

June 18, 2021

Well , actually I work at Miss , the Ministry of Silly Sausages

June 18, 2021

Smiles , the best pills.

Create Sausage shape with ARC offset

Recommended Posts

gsc

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

gsc

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

rlx

Link to comment

Share on other sites

dexus

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

gsc

Link to comment

Share on other sites

rlx

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity