Lee Mac Posted July 19, 2009 Posted July 19, 2009 Was bored, so messed around with this little program. Hit TAB to switch modes [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:acEd [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] ent foo prop Obj gr[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] foo [b][color=DARKRED]'[/color][/b][b][color=BLUE]angle[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Arc: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"AcDbArc"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ObjectName[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] prop [b][color=RED]([/color][/b]propt Obj [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] gr [b][color=RED]([/color][/b][b][color=BLUE]grread[/color][/b] [b][color=DARKRED]'[/color][/b]t [b][color=#009900]6[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]listp[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cPt [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-put-property[/color][/b] Obj prop [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]eval[/color][/b] foo[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get[/color][/b] Obj [b][color=DARKRED]'[/color][/b]Center[b][color=RED])[/color][/b] cPt[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]grdraw[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get[/color][/b] Obj [b][color=DARKRED]'[/color][/b]Center[b][color=RED])[/color][/b] cPt [b][color=#009900]30[/color][/b] [b][color=#009900]1000[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]t[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vl-position[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] gr[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]25[/color][/b] [b][color=#009900]3[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]2[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]9[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] foo [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] foo [b][color=DARKRED]'[/color][/b][b][color=BLUE]angle[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]distance[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]angle[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] prop [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vl-position[/color][/b] prop [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b]EndAngle StartAngle[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] prop [b][color=DARKRED]'[/color][/b]Radius[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] prop [b][color=RED]([/color][/b]propt Obj cPt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vl-position[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]13[/color][/b] [b][color=#009900]32[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] propt [b][color=RED]([/color][/b]Obj pt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]vlax-get[/color][/b] Obj [b][color=DARKRED]'[/color][/b]StartPoint[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]distance[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]vlax-get[/color][/b] Obj [b][color=DARKRED]'[/color][/b]EndPoint[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]EndAngle[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b] [b][color=DARKRED]'[/color][/b]StartAngle[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Enjoy Lee Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 What are the details of its function? And also, is the LISP business running slow for you? (LOL) Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 What are the details of its function? And also, is the LISP business running slow for you? (LOL) Just click on an ARC and you'll see As for the "LISP business"... well, ideas are hard to come by, and so I just toy around with the few I have Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 WOW! That is impressive. This has become my new favorite LISP program. This works better than trimming. I have 2 questions/suggestions about it: 1. Would it be possible to enter the angle at which you wish to cut off? 2. Would it also be possible to do the same thing with circles as well? Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 WOW! That is impressive. This has become my new favorite LISP program. This works better than trimming. I have 2 questions/suggestions about it: 1. Would it be possible to enter the angle at which you wish to cut off? 2. Would it also be possible to do the same thing with circles as well? Thanks I'm not sure which is more intuitive: entering the angle you wish to cut off, or the angle of arc you wish to keep? Circles are easier, unless you are thinking of trying to turn the circle into an arc. Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 Thanks I'm not sure which is more intuitive: entering the angle you wish to cut off, or the angle of arc you wish to keep? What about both? Just use the TAB key to switch what you want. Circles are easier, unless you are thinking of trying to turn the circle into an arc. And about the circles, That is what I was thinking. If that makes sense. Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 And about the circles, That is what I was thinking. If that makes sense. If can be done, but the routine will need to be "bulked up" a bit An inbetweener: (defun c:acEd (/ ent foo prop Obj gr) (vl-load-com) (if (and (setq foo 'distance prop 'Radius ent (entsel "\nSelect Arc/Circle: ")) (vl-position (vla-get-ObjectName (setq Obj (vlax-ename->vla-object (car ent)))) '("AcDbArc""AcDbCircle"))) (while (progn (setq gr (grread 't 6 0)) (redraw) (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr)))) (vlax-put-property Obj prop ((eval foo) (vlax-get Obj 'Center) cPt)) (grdraw (vlax-get Obj 'Center) cPt 30 1000) t) ((vl-position (car gr) '(25 3)) nil) ((eq 2 (car gr)) (cond ((eq 9 (cadr gr)) (and (eq "AcDbArc" (vla-get-ObjectName Obj)) (setq foo (cond ((eq foo 'angle) 'distance) (t 'angle)))) (setq prop (cond ((vl-position prop '(EndAngle StartAngle)) (setq prop 'Radius)) (t (setq prop (propt Obj cPt)))))) ((vl-position (cadr gr) '(13 32)) nil) (t))) (t))))) (redraw) (princ)) (defun propt (Obj pt) (if (eq "AcDbArc" (vla-get-ObjectName Obj)) (cond ((> (distance pt (vlax-get Obj 'StartPoint)) (distance pt (vlax-get Obj 'EndPoint))) 'EndAngle) (t 'StartAngle)) 'Radius)) Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 What's different about this LISP? What makes this an inbetweener? Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 What's different about this LISP? What makes an inbetweener? The above will allow Circle selection Inbetweener: Something to keep you amused while I mess around with the code Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 Well, that will sure keep me entertained. Looking forward to seeing the new code! Quote
flowerrobot Posted July 20, 2009 Posted July 20, 2009 My friend that will be quite handy, particularly with circles. (Note: Did you use any scources for the proper use of grread & the like, As i started to look into this week, with no success, I can make lines get bigger, but not retract, ps. i have search the site, hence my little success) Cheers Flower Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 My friend that will be quite handy, particularly with circles. (Note: Did you use any scources for the proper use of grread & the like, As i started to look into this week, with no success, I can make lines get bigger, but not retract, ps. i have search the site, hence my little success) Cheers Flower Thanks Flower, The Visual LISP help files are a good source of information for GrRead - just about everything you need to know is there. Also, try searching at theSwamp.org for GrRead - loads of information there. Lee Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 As an improvement: (defun c:acEd (/ *error* foo prop str ent Obj eLst gr dat val) (vl-load-com) (defun *error* (err) (if (and Obj eLst (not (vlax-erased-p Obj))) (mapcar (function (lambda (x) (vlax-put-property Obj (car x) (cdr x)))) eLst)) (if (not (wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n** Error: " err " **")) (princ "\n*Cancel*")) (redraw) (princ)) (setq foo 'distance prop 'Radius str "") (while (progn (setq ent (entsel "\nSelect Arc/Circle: ")) (cond ((vl-consp ent) (if (vl-position (vla-get-ObjectName (setq Obj (vlax-ename->vla-object (car ent)))) '("AcDbArc" "AcDbCircle")) nil (princ "\n** Invalid Object Selection **"))) (t (princ "\n** Nothing Selected **"))))) (foreach x '(StartAngle EndAngle Radius) (and (vlax-property-available-p Obj x) (setq eLst (cons (cons x (vlax-get-property Obj x)) eLst)))) (while (progn (setq gr (grread 't 15 0) dat (cadr gr)) (redraw) (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr)))) (vlax-put-property Obj prop ((eval foo) (vlax-get Obj 'Center) cPt)) (grdraw (vlax-get Obj 'Center) cPt 30 (~ -2)) t) ((vl-position (car gr) '(25 3)) nil) ((eq 2 (car gr)) (cond ((or (< 47 dat 58) (eq dat 46)) (princ (chr dat)) (setq str (strcat str (chr dat)))) ((and (= dat (> (strlen str) 0)) (princ (strcat (chr " " (chr )) (setq str (substr str 1 (1- (strlen str))))) ((eq 9 dat) (and (eq "AcDbArc" (vla-get-ObjectName Obj)) (setq foo (cond ((eq foo 'angle) 'distance) (t 'angle)))) (setq prop (cond ((vl-position prop '(EndAngle StartAngle)) (setq prop 'Radius)) (t (setq prop (propt Obj cPt)))))) ((vl-position dat '(13 32)) (cond ((or (and (eq foo 'angle) (setq val (angtof str 0))) (and (eq foo 'distance) (setq val (distof str)))) (vlax-put-property Obj prop val)))) '(t))) (t)))) (redraw) (princ)) (defun propt (Obj pt) (if (eq "AcDbArc" (vla-get-ObjectName Obj)) (cond ((> (distance pt (vlax-get Obj 'StartPoint)) (distance pt (vlax-get Obj 'EndPoint))) 'EndAngle) (t 'StartAngle)) 'Radius)) Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 The current code you have out, is that going to allow you to pick the angle? And I think i may have found an error, I went to try and specify the angle (I picked 35 as an example) and it created a full circle. Is that normal? CORRECTION: The circle is not a complete circle, there is about 4 degrees missing from it. Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 The angle specification is for the Start and End Angle of the arc - dependining on which side you pick. i.e. a 45 deg start angle would look something like: Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 Also Lee Mac, Would it be possible to use OSNAPS? i.e. - The orange line can SNAP to the end of a line. Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 Also Lee Mac, Would it be possible to use OSNAPS? i.e. - The orange line can SNAP to the end of a line. GrRead and OSnaps don't mix, as the OSnap functionality has to be mimicked and coded for manually. But it can be done. Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 hmm interesting. Well it is fun to watch this code progress. Quote
Lee Mac Posted July 20, 2009 Author Posted July 20, 2009 I stole some code from my other functions ;; Quick Arc Editor, by Lee McDonnell 20.07.2009 (defun c:acEd (/ *error* foo prop str ent Obj eLst gr dat val osPt) (vl-load-com) (defun *error* (err) (if (and Obj eLst (not (vlax-erased-p Obj))) (mapcar (function (lambda (x) (vlax-put-property Obj (car x) (cdr x)))) eLst)) (if (not (wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n** Error: " err " **")) (princ "\n*Cancel*")) (redraw) (princ)) (setq foo 'distance prop 'Radius str "") (while (progn (setq ent (entsel "\nSelect Arc/Circle: ")) (cond ((vl-consp ent) (if (vl-position (vla-get-ObjectName (setq Obj (vlax-ename->vla-object (car ent)))) '("AcDbArc" "AcDbCircle")) nil (princ "\n** Invalid Object Selection **"))) (t (princ "\n** Nothing Selected **"))))) (foreach x '(StartAngle EndAngle Radius) (and (vlax-property-available-p Obj x) (setq eLst (cons (cons x (vlax-get-property Obj x)) eLst)))) (while (progn (setq gr (grread 't 15 0) dat (cadr gr)) (redraw) (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr)))) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap dat (osLst (getvar "OSMODE"))))) (osMark osPt)) (vlax-put-property Obj prop ((eval foo) (vlax-get Obj 'Center) cPt)) (grdraw (vlax-get Obj 'Center) cPt 30 (~ -2)) t) ((eq 25 (car gr)) nil) ((eq 3 (car gr)) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap dat (osLst (getvar "OSMODE"))))) (vlax-put-property Obj prop ((eval foo) (vlax-get Obj 'Center) osPt)))) ((eq 2 (car gr)) (cond ((or (< 47 dat 58) (eq dat 46)) (princ (chr dat)) (setq str (strcat str (chr dat)))) ((and (= dat (> (strlen str) 0)) (princ (strcat (chr " " (chr )) (setq str (substr str 1 (1- (strlen str))))) ((eq 6 dat) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))))) ((eq 9 dat) (and (eq "AcDbArc" (vla-get-ObjectName Obj)) (setq foo (cond ((eq foo 'angle) 'distance) (t 'angle)))) (setq prop (cond ((vl-position prop '(EndAngle StartAngle)) (setq prop 'Radius)) (t (setq prop (propt Obj cPt)))))) ((vl-position dat '(13 32)) (cond ((or (and (eq foo 'angle) (setq val (angtof str 0))) (and (eq foo 'distance) (setq val (distof str)))) (vlax-put-property Obj prop val)))) '(t))) (t)))) (redraw) (princ)) (defun propt (Obj pt) (if (eq "AcDbArc" (vla-get-ObjectName Obj)) (cond ((> (distance pt (vlax-get Obj 'StartPoint)) (distance pt (vlax-get Obj 'EndPoint))) 'EndAngle) (t 'StartAngle)) 'Radius)) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Quote
CADMASTER1128 Posted July 20, 2009 Posted July 20, 2009 is that final version of this code? I really like this version! Quote
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.