topic Re: Explode Circle in Visual LISP, AutoLISP and General Customization Forum

Explode Circle

john.uhden — Thu, 29 Dec 2016 03:20:47 GMT

My apologies. I made fun in another thread about exploding circles.

To compensate (partially), I submit the following:

(It actually turns a circle into a specified number of arcs)

;; ExplodeCircle.lsp written for fun by John F. Uhden (12-28-16)
;;
(defun c:ExplodeCircle (  / *error* vars ans n e ent dxf8 dxf10 dxf40 dang eang bang)
  (vl-load-com)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho" "osmode")))
  (mapcar '(lambda (x)(setvar (car x) 0)) vars)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (while (not n)
    (initget 7)
    (setq ans (getint "\nEnter number of arcs to create: "))
    (if (= (type ans) 'INT)(setq n ans))
  )
  (while (setq e (car (entsel "\nSelect a circle to explode: ")))
    (and
      (setq ent (entget e))
      (or
        (= (cdr (assoc 0 ent)) "CIRCLE")
        (prompt "\nEntity selected is not a circle.")
      )
      (entdel e)
      (setq dxf8  (assoc 8 ent))
      (setq dxf10  (assoc 10 ent))
      (setq dxf40  (assoc 40 ent))
      (setq dang (/ pi n 0.5))
      (setq bang 0.0)
      (repeat n
        (setq eang (+ bang dang))
        (entmakex (list '(0 . "ARC") dxf8 dxf10 dxf40 (cons 50 bang)(cons 51 eang)))
        (setq bang eang)
      )
    )
  )
  (*error* nil)
)
(defun c:XC ()(c:ExplodeCircle))

I really have no use for it, but maybe it could be modified to be of some value (sorta like divide and break).

And, no, it doesn't check for locked layers. Nor do you see anything happening.

Plus I should have used errmode so that a missed pick doesn't end it.

But that's all you should expect from an old fart.

Re: Explode Circle

john.uhden — Fri, 30 Dec 2016 23:22:32 GMT

This is an improved version.

It uses "errno" so you can miss a pick without it stopping.

It uses (sssetfirst) to highlight exploded circles.

Locked layers are notified.

;; ExplodeCircle.lsp written for fun by John F. Uhden (12-28-16)
;; Improved (12-30-16)
;;
(defun c:ExplodeCircle (  / *error* vars ans n e ent Layer Ldata Flag dang eang bang ss)
  (vl-load-com)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (sssetfirst)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho" "osmode")))
  (mapcar '(lambda (x)(setvar (car x) 0))  vars)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (while (not n)
    (initget 7)
    (setq ans (getint "\nEnter number of arcs to create: "))
    (if (= (type ans) 'INT)(setq n ans))
  )
  (setq ss (ssadd))
  (setvar "errno" 0)
  (while (/= (getvar "errno") 52)
    (and
      (setq e (car (entsel "\nSelect a circle to explode: ")))
      (setq ent (entget e))
      (or
        (= (cdr (assoc 0 ent)) "CIRCLE")
        (prompt "\nEntity selected is not a circle.")
      )
      (setq Layer (cdr (assoc 8 ent)))
      (setq Ldata (tblobjname "layer" Layer))
      (setq Ldata (entget Ldata))
      (setq Flag (cdr (assoc 70 Ldata)))
      (if  (= (logand 4 Flag) 4)
        (prompt (strcat "\nLayer \"" Layer "\" is locked."))
        1
      )
      (entdel e)
      (setq dang (/ pi n 0.5))
      (setq bang 0.0)
      (repeat n
        (setq eang (+ bang dang))
        (ssadd
          (entmakex (list '(0 . "ARC") (assoc 8 ent) (assoc 10 ent) (assoc 40 ent) (cons 50 bang)(cons 51 eang)))
          ss
        )
        (sssetfirst nil ss)
        (setq bang eang)
      )
    )
  )
  (*error* nil)
)
(defun c:XC ()(c:ExplodeCircle))

Re: Explode Circle

Kent1Cooper — Sat, 31 Dec 2016 05:37:57 GMT

Here's a routine -- SubDivide.lsp with its SD command -- that I wrote about 5 years ago, that will do that. [I'd find the thread and post a link, but I've just updated it to work in newer versions -- the original used (command) for Undo End in its *error* handler, which is now frowned upon.]

It's not restricted to exploding Circles into Arcs, but will do the same kind of subdividing-into-equal-parts to any kind of finite-length (vlax-curve)-class object with linearity -- Circle, Arc, Line, Polyline of any variety, Ellipse or Spline, and in the last three cases, whether open or closed.

And it has the option to specify a Maximum segment length, rather than a specific number of segments, and it will calculate the minimum number of segments to subdivide into, so that each is no more than the specified Maximum length. It also remembers the number of segments or Maximum length you asked for, and offers it as a default on subsequent use.

It also uses a simpler way of determining whether an object's Layer is locked. You don't need to get the Layer as an object with (tblobjname), and then use (entget) on that object to get to the 70-code entry that holds that information, but can get that more directly from (tblsearch).

Another little comment.... I hadn't started doing things as follows at the time, and didn't update the attached to do it this way, but I've taken to doing multiple System Variable value saving and resetting in a way that's related to but briefer than what you've done, though admittedly it takes two variables instead of one to do it. Instead of doing this to save them:

(setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho" "osmode")))

and this to turn them off:

(mapcar '(lambda (x)(setvar (car x) 0)) vars)

and this to reset them:

(mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)

I've done this [for the same pair -- the list varies with different routines] to save them:

(setq

svnames '(cmdecho osmode)

svvals (mapcar 'getvar svnames)

)

and this to turn them off:

(mapcar 'setvar svnames '(0 0))

and this to reset them:

(mapcar 'setvar svnames svvals)

Re: Explode Circle

john.uhden — Sat, 31 Dec 2016 15:25:59 GMT

Kent: Thank you for your input. I am truly honored to have been outdone by you.