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

Advertisements