Jump to content

Draw circle with polygon


AIberto

Recommended Posts

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

Link to comment
Share on other sites

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




Link to comment
Share on other sites

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

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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 ?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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:

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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! :)

Link to comment
Share on other sites

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:

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.

×
×
  • Create New...