AIberto Posted September 6, 2014 Share Posted September 6, 2014 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. eg. inside eg. outside Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 6, 2014 Share Posted September 6, 2014 Make circles at vertices of offseted polygon and then erase that offset... Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 6, 2014 Share Posted September 6, 2014 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) ) Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 7, 2014 Share Posted September 7, 2014 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) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 7, 2014 Share Posted September 7, 2014 (edited) Good effort Tharwat 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 July 3, 2019 by Lee Mac Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 7, 2014 Share Posted September 7, 2014 Good effort Tharwat Thank you so much , your feedback means a lot to me Quote Link to comment Share on other sites More sharing options...
AIberto Posted September 7, 2014 Author Share Posted September 7, 2014 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 ? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 7, 2014 Share Posted September 7, 2014 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)) Quote Link to comment Share on other sites More sharing options...
AIberto Posted September 7, 2014 Author Share Posted September 7, 2014 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! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 8, 2014 Share Posted September 8, 2014 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))) Quote Link to comment Share on other sites More sharing options...
GP_ Posted September 8, 2014 Share Posted September 8, 2014 ...re-entmake... (entdel ename) Deletes objects (entities) or restores previously deleted objects Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 8, 2014 Share Posted September 8, 2014 (entdel ename) Deletes objects (entities) or restores previously deleted objects Excellent to know Thank you GP . Quote Link to comment Share on other sites More sharing options...
pBe Posted September 8, 2014 Share Posted September 8, 2014 **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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 8, 2014 Share Posted September 8, 2014 Lee, Thanks so much! very good! 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! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 8, 2014 Share Posted September 8, 2014 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 8, 2014 Share Posted September 8, 2014 You're welcome Tharwat Quote Link to comment Share on other sites More sharing options...
GP_ Posted September 9, 2014 Share Posted September 9, 2014 Thank you GP . You're welcome. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.