Jump to content

Draw circle with polygon

AIberto

By AIberto
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

AIberto Collaborator

AIberto

Posted
Posted

Hi dear friend.I need some help.

Draw circle with polygon

1 step. Choose closed object ,Must be a polygon.

2 step. Enter the Offset distance .

3 step. Enter the the diameter of the circle.

4 step. Choose inside or outside of polygon.

 

eg.

jj.png

 

eg. inside

jj2.png

 

eg. outside

jj3.png

marko_ribar Veteran

marko_ribar

Posted
Posted

Make circles at vertices of offseted polygon and then erase that offset...

jdiala Enthusiast

jdiala

Posted
Posted
Make circles at vertices of offseted polygon and then erase that offset...

 

try this as marko suggested

(defun C:test (/ e sel d c p en)
;;;jdiala 09-06-14 Cadtutor.net ;;;
(vl-load-com)
(if
(setq e
 (while
   (not e)
     (progn 
       (setq sel (entsel "\nSelect a polygon :"))
       (cond
         ( (= nul sel)
           (princ "\nMissed! ")
         )
         ( (/= "LWPOLYLINE" (cdr (assoc 0 (entget (car sel)))))
           (princ "\nInvalid selection. " )
         )        
         ( (and
             (= "LWPOLYLINE" (cdr (assoc 0 (entget (car sel)))))
             (= 1 (cdr (assoc 70 (entget (car sel)))))
           )  
           (setq e sel))
         (t nil)
       ) 
     )
 )
 d (getdist "\nEnter offset distance :")
 c (/ (getdist "\nEnter diameter of circle :") 2.0)
 p (getpoint "\nPick side to offset :")
 )
 (progn
  (command "_.offset" d e p "")
  (mapcar 
    (function 
      (lambda (z)
        (entmake 
          (list 
            (cons 0 "CIRCLE") 
            (cons 10 (cdr z)) 
            (cons 40 c)
          )
        )
        (entmake 
          (list 
            (cons 0 "LINE") 
            (cons 10 (polar (cdr z) 0 (* c 1.5))) 
            (cons 11 (polar (cdr z) pi (* c 1.5))) 
          )
        )
        (entmake 
          (list 
            (cons 0 "LINE") 
            (cons 10 (polar (cdr z) (/ pi 2.) (* c 1.5))) 
            (cons 11 (polar (cdr z) (* pi 1.5) (* c 1.5))) 
          )
        )
      )
    ) 
    (vl-remove-if-not 
      (function 
        (lambda (x) 
          (= 10 (car x))
        )
      ) 
      (entget 
        (setq en (entlast))
      )
    )
  )
  (entdel en)
 )
)
(princ)
)

Tharwat Grand Master

Tharwat

Posted
Posted

DYNAMIC program :)

 

(defun c:Test (/ _line _screw l lk s sn a p1 p2 gr ang o lst pts)
 ;;	Author : Tharwat Al Shoufi		;;
 ;;	Date : 07.Sep.2014			;;
 ;; Dynamic draw a circle with a cross of line	;;
 ;; at specific offset distance of a polyline	;;
 (defun _line (p q) (entmakex (list '(0 . "LINE") (cons 62 4) (cons 10 p) (cons 11 q))))
 (defun _screw (pts r / lst 1p)
   (mapcar '(lambda (p)
              (setq lst (cons (entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r))) lst)
                    lst (cons (_line (setq 1p (polar p 0. (* r 1.2))) (polar p pi (* r 1.2))) lst)
                    lst (cons (_line (setq 1p (polar p (* pi 1.5) (* r 1.2))) (polar p (* pi 0.5) (* r 1.2))) lst)
              )
            )
           pts
   )
   lst
 )
 (if (eq 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer)))))))
   (progn (alert "Warning ! Current layer is Locked") (setq lk t))
 )
 (setq l (entlast))
 (if (and (not lk)
          (setq s (entsel "\n Select a polyline :"))
          (eq (cdr (assoc 0 (entget (setq sn (car s))))) "LWPOLYLINE")
          (setq *dist* (cond ((getdist (strcat "\n Offset distance < "
                                               (rtos (if *dist*
                                                       *dist*
                                                       (setq *dist* 1.0)
                                                     )
                                                     2
                                                     2
                                               )
                                               " > :"
                                       )
                              )
                             )
                             (*dist*)
                       )
          )
          (setq *rad* (cond ((getdist (strcat "\n Specify radius of Circles < "
                                              (rtos (if *rad*
                                                      *rad*
                                                      (setq *rad* 1.0)
                                                    )
                                                    2
                                                    2
                                              )
                                              " > :"
                                      )
                             )
                            )
                            (*rad*)
                      )
          )
     )
   (progn (setq a (fix (vlax-curve-getparamatpoint sn (vlax-curve-getclosestpointto sn (cadr s)))))
          (setq p1 (vlax-curve-getpointatparam sn a))
          (setq p2 (vlax-curve-getpointatparam sn (setq a (1+ a))))
          (while (and (eq (car (setq gr (grread t 15 0))) 5)
                      (not (redraw))
                      (if (minusp (sin (- (angle p1 p2) (angle p2 (cadr gr)))))
                        (setq ang t)
                        (progn (setq ang nil) t)
                      )
                 )
            (vla-offset
              (vlax-ename->vla-object sn)
              (if ang
                (- *dist*)
                *dist*
              )
            )
            (if o
              (entdel o)
            )
            (if lst
              (mapcar 'entdel lst)
            )
            (if (not (eq (setq o (entlast)) l))
              o
            )
            (setq l   o
                  pts nil
            )
            (foreach x (entget o)
              (if (eq (car x) 10)
                (setq pts (cons (list (cadr x) (caddr x) 0.) pts))
              )
            )
            (setq lst (_screw pts *rad*))
          )
          (if l
            (entdel l)
          )
   )
 )
 (princ)
)

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

Good effort Tharwat :thumbsup:

 

Here is my take on it: 

;; Polyline Circles  -  Lee Mac
;; Generates a set of circles with centerlines for every vertex of a selected polyline,
;; offset inside or outside by a given distance based on the cursor position.

(defun c:polyc ( / *error* dia ent enx flg lst obj ocs off par pt1 pt2 pt3 )

   (defun *error* ( msg )
       (foreach grp lst (foreach ent grp (if (entget ent) (entdel ent))))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (while
       (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect polyline: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent) nil)
               (   (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
                   (princ "\nSelected object is not a polyline.")
               )
           )
       )
   )
   (if (and (= 'ename (type ent))
            (setq obj (vlax-ename->vla-object ent))
            (setq off (getdistwithdefault "\nSpecify offset distance" 'polyc:off))
            (setq dia (getdistwithdefault "\nSpecify circle diameter" 'polyc:dia))
            (setq dia (/ dia 2.0)
                  ocs (assoc 210 enx)
            )
       )
       (if
           (apply 'and
               (setq lst
                   (mapcar
                       (function
                           (lambda ( x )
                               (apply 'append
                                   (mapcar
                                       (function
                                           (lambda ( y / r )
                                               (setq r
                                                   (apply 'append
                                                       (mapcar
                                                           (function
                                                               (lambda ( p )
                                                                   (cons (entmakex (list '(0 . "CIRCLE") p (cons 40 dia) ocs))
                                                                       (mapcar
                                                                           (function
                                                                               (lambda ( a )
                                                                                   (entmakex
                                                                                       (list
                                                                                          '(0 . "LINE")
                                                                                           (cons 10 (trans (mapcar '+ (cdr p) a) (cdr ocs) 0))
                                                                                           (cons 11 (trans (mapcar '+ (cdr p) (mapcar '- a)) (cdr ocs) 0))
                                                                                       )
                                                                                   )
                                                                               )
                                                                           )
                                                                           (list (list (* dia 1.5) 0.0) (list 0.0 (* dia 1.5)))
                                                                       )
                                                                   )
                                                               )
                                                           )
                                                           (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget (vlax-vla-object->ename y)))
                                                       )
                                                   )
                                               )
                                               (vla-delete y)
                                               r
                                           )
                                       )
                                       x
                                   )
                               )
                           )
                       )
                       (list
                           (catchapply 'vlax-invoke (list obj 'offset off))
                           (catchapply 'vlax-invoke (list obj 'offset (- off)))
                       )
                   )
               )
           )
           (progn
               (foreach ent (car lst) (entdel ent))
               (princ "\nChoose offset side: ")
               (while (= 5 (car (setq pt1 (grread t 13 0))))
                   (setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent (trans (cadr pt1) 1 0)))
                         pt2 (trans (vlax-curve-getpointatparam ent (fix par)) 0 1)
                         pt3 (trans (vlax-curve-getpointatparam ent (1+ (fix par))) 0 1)
                   )
                   (if (not (eq flg (setq flg (minusp (sin (- (angle pt2 (cadr pt1)) (angle pt2 pt3)))))))
                       (foreach grp lst (foreach ent grp (entdel ent)))
                   )
               )
           )
           (progn
               (princ "\nOffset distance too large - unable to perform internal offset.")
               (foreach x (apply 'append lst) (entdel x))
           )
       )
   )
   (princ)
)
(defun getdistwithdefault ( msg sym )
   (set sym (cond ((getdist (strcat msg (if (eval sym) (strcat " <" (rtos (eval sym)) ">: ") ": ")))) ((eval sym))))
)
(defun catchapply ( fun arg / rtn )
   (if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)
(vl-load-com) (princ)
 

 

The above should also perform correctly in all UCS & Views.

Edited by Lee Mac
Tharwat Grand Master

Tharwat

Posted
Posted
Good effort Tharwat :thumbsup:

 

Thank you so much , your feedback means a lot to me :)

AIberto Collaborator

AIberto

Posted
  • Author
Posted

marko, jdiala, Tharwat , leemac

 

Thanks to all.

Very moved !

if polygon is not pline, it's line ,closed. How to do?

How to change the layer of center line ?

Lee Mac Grand Master

Lee Mac

Posted
Posted
if polygon is not pline, it's line ,closed. How to do?

 

Use PEDIT > Join to join the lines into a polyline before using the above programs.

 

How to change the layer of center line ?

 

In my code, change:

'(0 . [color=MAROON]"LINE"[/color])
([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] p) a) ([color=BLUE]cdr[/color] ocs) 0))

to:

'(0 . [color=MAROON]"LINE"[/color])
'(8 . [color=red]"Your Layer Here"[/color])
([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] p) a) ([color=BLUE]cdr[/color] ocs) 0))

AIberto Collaborator

AIberto

Posted
  • Author
Posted
Use PEDIT > Join to join the lines into a polyline before using the above programs.

 

 

 

In my code, change:

'(0 . [color=MAROON]"LINE"[/color])
([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] p) a) ([color=BLUE]cdr[/color] ocs) 0))

to:

'(0 . [color=MAROON]"LINE"[/color])
'(8 . [color=red]"Your Layer Here"[/color])
([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] p) a) ([color=BLUE]cdr[/color] ocs) 0))

 

Lee, Thanks so much! very good! :beer:

Tharwat Grand Master

Tharwat

Posted
Posted

Lee , I just can not understand how the following codes could re-entmake the objects after deleting them .

Could you please clarify it for me ?

 

(foreach grp lst (foreach ent grp (entdel ent)))

GP_ Rising Star

GP_

Posted
Posted
...re-entmake...

 

(entdel ename)

Deletes objects (entities) or restores previously deleted objects

Tharwat Grand Master

Tharwat

Posted
Posted

(entdel ename)

Deletes objects (entities) or restores previously deleted objects

 

Excellent to know :) Thank you GP .

pBe Grand Master

pBe

Posted
Posted

**OFF-TOPIC**

 

I remember the first time i saw entdel used that way was from the solution posted by stefan on a "challenge" thread at theswamp. :)

Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee, Thanks so much! very good! :beer:

 

Thank you :)

 

Lee , I just can not understand how the following codes could re-entmake the objects after deleting them .

Could you please clarify it for me ?

 

(foreach grp lst (foreach ent grp (entdel ent)))

 

As GP correctly states - the entdel is simply toggling the erase flag for the entity; erased entities are only removed from the drawing database when the drawing is closed.

 

Thank you for taking the time to study my code! :)

Tharwat Grand Master

Tharwat

Posted
Posted

Thank you Lee , after reading the entdel function in help document I was really surprised what this function can do other than deleting entities .

 

Good to know that and thanks for being helpful and generous :thumbsup:

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...