Quick Circle Break

[flowerrobot]

My friend, We have sites avalible if you like, they are based in aus, but still quite quick, and cheap

 

 

What i said about distrbution, the programs i were loooking @ did not have headers, hence my asking.

 

But will discuss later, as just got home @ 4 from the club

(p.s. didnt come to the pc, but left it on for torrents)

[Lee Mac]

Thanks Flower, I will see what I can get arranged.

 

As for the program, this version (now with header ), will allow the user to change the linetype and layer of the resultant arc. I thought you would only want to change one of the arcs, but if you want to change both, just shout.

 

Make ammendments to the top of the LISP -

• Set the Layer to "" to use the current layer.
  
• If the layer does not exist it will be created.
  
• If the linetype does not exist it will be loaded. (I have only specified the acad.lin file, you may need to use the acadiso.lin file.

Lee

 

;; ============ cBrk.lsp ===============
;;
;;  FUNCTION:
;;  Will break a circle into two arcs at
;;  at points specified by the user.
;;  Option to change layer/linetype of one
;;  of the resultant arcs.
;;
;;  SYNTAX: cBrk
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;   Contact Lee Mac, CADTutor.net
;;                    TheSwamp.org
;;
;;  VERSION:
;;  3.0  ~  24.07.2009
;;
;; =====================================

(defun c:cBrk (/ ltype layer *error* vl ov p1 ent p2 aDef flag ent Objlst)
 (vl-load-com)
[color=Red][b]
 (setq ltype "HIDDEN")   ;; <<--  Linetype (can be "BYLAYER")
 (setq layer "Lee Mac")  ;; <<--  Layer    ("" for Current Layer)[/b][/color]
 

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (vla-StartUndoMark doc)

 (cond ((not (and (eq 'STR (type ltype)) (snvalid ltype)))
        (princ "\n** Linetype not Valid **"))
       ((not (eq 'STR (type layer)))
        (princ "\n** Layer Name not Valid **"))
       ((and (not (tblsearch "LTYPE" ltype))
             (not (eq "BYLAYER" ltype))
             (vl-catch-all-error-p
               (vl-catch-all-apply
                 (function
                   (lambda ( )
                     (vla-load
                       (vla-get-linetypes doc) ltype "acad.lin"))))))
        (princ "\n** Error Loading Linetype **"))
       (t

         (and (not (snvalid layer))
              (setq layer (getvar "CLAYER")))

         (if (not (tblsearch "LAYER" layer))
           (vla-add
             (vla-get-layers doc) layer))
        
         (setq vl '("CMDECHO" "OSMODE")
               ov (mapcar 'getvar vl))
         (or (eq 512 (logand 512 (getvar 'OSMODE)))
             (setvar 'OSMODE (+ (getvar 'OSMODE) 512)))

         (if (setq ss (ssget "_X" '((0 . "CIRCLE"))))
           (progn

             (setq Objlst (mapcar 'cadr (ssnamex ss)))
         
             (while
               (progn
                 (setq p1 (getpoint "\nSelect Point on Circle: "))
                 (cond ((vl-consp p1)
                        (if (not
                              (or (and (setq ent (car (nentselp p1)))
                                       (or (eq "CIRCLE" (cdr (assoc 0 (entget ent))))
                                           (setq ent nil)))
                                (while (and (not ent) Objlst)
                                  (and (vlax-curve-getParamatPoint (car Objlst) p1)
                                       (setq ent (car Objlst)))
                                  (setq Objlst (cdr Objlst))) ent))
                          (princ "\n** Point does not lie on a Circle **")))
                       (t (princ "\n** No Point Selected  **")))))

             (while
               (progn
                 (setq p2 (getpoint "\nSelect Second Point to Break: "))
                 (cond ((vl-consp p2)
                        (cond ((equal p1 p2 0.001)
                               (princ "\n** Points must be distinct **"))
                              (t (setq p2 (vlax-curve-getClosestPointto ent p2)) nil)))
                       (t (princ "\n** No Point Selected **")))))

             (setq cen (cdr (assoc 10 (entget ent))))
             (repeat 2
               (setq aDef
                 (list
                   (cons 100 "AcDcEntity")
                   (cons 0 "ARC")))
               (foreach dxf '(8 10 40 210)
                 (setq aDef
                   (cons
                     (assoc dxf (entget ent)) aDef)))
               (setq aDef
                 (append
                   (reverse aDef)
                     (list
                       (cons 50
                         (if flag
                           (angle cen p1) (angle cen p2)))
                       (cons 51
                         (if flag
                           (angle cen p2) (angle cen p1))))))
               (setq arc (entmakex aDef))
               (if (not flag)
                 (progn
                   (setq arc (vlax-ename->vla-object arc))
                   (vla-put-layer arc layer)
                   (vla-put-linetype arc ltype)))
               (setq flag t))

             (entdel ent))
           
           (princ "\n** No Circles Found in Drawing **"))))

 (vla-EndUndoMark doc)
 (if ov (mapcar 'setvar vl ov))
 (princ))

[ReMark]

Just curious Lee. How many LISP routines, VBA, etc. do you think you have written so far?

[ReMark]

If you are going to give away all your code to anyone and everyone that comes along and either asks (mostly) or demands (on rare occassion) then you might as well consider a different career and write code as a hobby. You don't know someone at school who can set up a website for you or show you how to go about it yourself?

[Lee Mac]

Just curious Lee. How many LISP routines, VBA, etc. do you think you have written so far?

 

Quite a few, these are just the ones I can be bothered to save, more inside subfolders also...

 

 

 

If you are going to give away all your code to anyone and everyone that comes along and either asks (mostly) or demands (on rare occassion) then you might as well consider a different career and write code as a hobby. You don't know someone at school who can set up a website for you or show you how to go about it yourself?

 

I never said I will just give aways all my code - I know that I write a few codes for those that request them, but I think this is going to change. Even if I set up a website (a friend of mine could do this for me), and charged, say £3-£5 for a LISP routine, that would soon mount up and would not be extortionate.

 

I am not really considering this as a job, but rather keep it as a hobby - I will see where my Maths degree takes me.

 

Lee

[ReMark]

Thank you for clearing that up for me. I thought you were leaning towards programming. BTW...that's a lot of files. Do you ever sleep? And when you do, do you dream in code or of code?

[Lee Mac]

Thank you for clearing that up for me. I thought you were leaning towards programming. BTW...that's a lot of files. Do you ever sleep? And when you do, do you dream in code or of code?

 

Well, at the minute, programming is a hobby/interest of mine - my main focus is (or should be!) my maths degree, which I hope will put me in good standing for job when this recession clears up... :wink:

 

A lot of files indeed... I really need to clear it up - some are from when I very first started and are very simple. But most of the time, with a new request, I find I have already written the base of the code in the past, and just need to tweak it

[flowerrobot]

Lee

 

Would it possible to include ellipes?

 

I would do it my self, but its your code

[Lee Mac]

I'll see what I can do mate if I get a minute

[CadTechJGC184]

Lee Mac is the man! Is there classes I can take that will teach me the things that you know Lee Mac?

[CADMASTER1128]

Lee Mac is the man! Is there classes I can take that will teach me the things that you know Lee Mac?

 

I am willing to bet there is a class. But Lee Mac has close 1000 LISP programs under his belt. It is going to take you awhile to catch up with him.

[Commandobill]

Lee Mac is the man! Is there classes I can take that will teach me the things that you know Lee Mac?

 

I heard Lee Mac once wrote a LISP to feed starving kids....

[Freerefill]

LeeMac doesn't eat his meals, he

 

(mapcar 'eat '(brkfst lunch dinner))

[Commandobill]

Lee Mac doesn't actually go on Cadtutor.net he wrote a lisp to respond for him

[Freerefill]

Lee Mac can stop bullets with a closed paren.

[Commandobill]

lee mac wrote a lisp to calculate to the end of pi

[Freerefill]

Lee Mac was once called upon to save the world. He wrote:

 

(vla-put-Status (vlax-get-world-object) 'safe)

 

and there was much rejoicing.

[The Buzzard]

Lee Mac was once called upon to save the world. He wrote:

 

(vla-put-Status (vlax-get-world-object) 'safe)

 

and there was much rejoicing.

 

Yea!!!!!!!!

[Commandobill]

Lee mac wrote a LISP to create a body guard for himself....

 

chuck norris was born

[The Buzzard]

Lee mac wrote a LISP to create a body guard for himself....

 

chuck norris was born

 

I think Lee Mac could be related to Barbra Walters.

She speaks with a lisp too.