;;; Draw Circles on user selected blocks, convert selected circles to polylines and change it width
;;; Based on Kent Cooper approach
;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/draw-multiple-circles-using-a-point-selection-set/td-p/3112918
;;; Combined and slightly modified by Igal Averbuh 2017
;; CirclePolylineSwap.lsp [command names: C2P & P2C]
;; Two commands, to convert in both directions between Circles and
;; circular Polylines. Both commands:
;; 1. filter User selection for only appropriate objects on unlocked Layers;
;; 2. remove selected/converted objects, but can be edited to retain them;
;; 3. account for different Coordinate Systems;
;; 4. apply selected objects' non-default and/or non-Bylayer colors, line-
;; types, linetype scales, lineweights, and/or thicknesses to conversions.
;; See additional notes above each command's definition.
;; Kent Cooper, last edited 25 February 2015

;; C2P
;; To convert selected Circle(s) to two-equal-arc-segment closed zero-
;; width Polyline circle(s) [Donut(s) w/ equal inside & outside diameters],
;; which can then be modified as desired [given width, etc.], since Pedit
;; will not accept selection of Circles to convert them.
; Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)
(defun C:C2P1 (/ *error* doc conv csel cir cdata cctr crad pdata)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
); defun -- *error*

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq conv 0)
(prompt "\nTo convert Circle(s) to Polyline equivalent(s),")
(setq converted (ssadd))
(if (setq csel (ssget "X" '((0 . "CIRCLE")))); User selection
(progn
(repeat (sslength csel); then
(setq
cir (ssname csel 0); Circle entity name
cdata (entget cir); entity data
cctr (cdr (assoc 10 cdata)); center point, OCS for Circle & LWPolyline w/ WCS 0,0,0 as origin
crad (cdr (assoc 40 cdata)); radius
pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) cdata)
; start Polyline entity data list -- remove Circle-specific entries from
; Circle's entity data, and extrusion direction; 62 Color, 6 Linetype, 48
; LTScale, 370 LWeight, 39 Thickness present only if not default/bylayer
); setq
(entmake
(append ; add Polyline-specific entries
'((0 . "LWPOLYLINE") (100 . "AcDbEntity"))
pdata ; remaining non-entity-type-specific entries
(list
'(100 . "AcDbPolyline")
'(90 . 2); # of vertices
(cons 70 (1+ (* 128 (getvar 'plinegen)))); closed [the 1], and uses
; current linetype-generation setting; change above line to
; '(70 . 129) to force linetype generation on, '(70 . 1) to force it off
'(43 . 0.0); global width
(cons 38 (caddr cctr)); elevation in OCS above WCS origin [Z of Circle center]
(cons 10 (list (- (car cctr) crad) (cadr cctr))); vertex 1
'(40 . 0.0) '(41 . 0.0) '(42 . 1); 0 start & end widths, semi-circle bulge factor
(cons 10 (list (+ (car cctr) crad) (cadr cctr))); vertex 2
'(40 . 0.0) '(41 . 0.0) '(42 . 1)
(assoc 210 cdata) ; extr. dir. at end [if in middle, reverts to (210 0.0 0.0 1.0) in (entmake)]
); list
); append
); entmake
(ssdel cir csel)
(entdel cir); [remove or comment out this line to retain selected Circle(s)]
(ssadd (entlast) converted)
(setq conv (1+ conv))
); repeat -- then
(prompt (strcat "\n" (itoa conv) " Circle(s) converted to Polyline(s)."))
(command "select" converted "")
(sssetfirst nil converted)
(ssget "_I")
); progn -- then
(prompt "\nNo Circle(s) found [on unlocked Layer(s)]."); else
); if
(vla-endundomark doc)
(princ)
); defun

;; Polyline Width - Lee Mac
;; Applies a given constant width to all segments in a selection of polylines.

(defun c:psw ( / *error* idx sel wid )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel (LM:ssget "\nSelect polylines: " '("P" ((0 . "LWPOLYLINE,POLYLINE")))))

(progn
(initget 4)
(setq wid (getdist (strcat "\nSpecify Width of Pline : ")))
(repeat (setq idx (sslength sel))
(vla-put-constantwidth (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) wid)
)
)
)
(*error* nil)
(princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)

(Defun C:cib1 (/ SSblocks)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq blkname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))
(setq wid (getdist (strcat "\nSpecify Circle Radius : ")))

(setq

SSblocks (ssget "X" (list (cons 2 blkname)))

)
(repeat (sslength SSblocks)
(command

"_.circle"

(cdr (assoc 10 (entget (ssname SSblocks 0)))); center

wid ; radius

); command
(ssdel (ssname SSblocks 0) SSblocks)

); repeat

(princ)
);defun

(defun C:cib ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:cib1)
(c:c2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:cib)

Advertisements