;Ellipses to Plines (c)1999, Oleg Khenson
;Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)

(defun C:E2P1 (/ A CEN CLA CMD DIS EN END_P1
END_P2 ENT I K LA LT M MINOR%
NM OLDERR OS PELMODE SS
)
(defun DXF (CODE ELIST) (cdr (assoc CODE ELIST)))
(defun EL2PL_ERR (S)
(if (/= S "Function cancelled")
(princ (strcat "\nError: " S))
)
(setvar "CMDECHO" CMD)
(if OS
(setvar "OSMODE" OS)
)
(setq *ERROR* OLDERR
OLDERR NIL
)
(princ)
)
(setq OLDERR *ERROR*
*ERROR* EL2PL_ERR
)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq converted (ssadd))
(princ "\nSelect Ellipses to be converted to PLines: ")
(setq SS (ssget '((0 . "ELLIPSE"))))
(command ".UNDO" "G")
(if SS
(progn
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq I 0
K 0
M 0
)
(repeat (sslength SS) ; for each entity from SS
(setq A (entget (setq NM (ssname SS I)
ENT NM
)
)
LA (DXF 8 A)
)
(if (< (cdr (assoc 70 (tblsearch "LAYER" LA))) 4)
(progn
(if (= (DXF 0 A) "ELLIPSE")
(progn
(setq LT (DXF 6 A)
CEN (DXF 10 A)
MINOR% (DXF 40 A)
END_P1 (mapcar '+ CEN (DXF 11 A))
DIS (distance CEN END_P1)
END_P2 (polar
CEN
(+ (angle CEN END_P1) (/ pi 2.0))
(* DIS MINOR%)
)
)
(setq PELMODE (getvar "PELLIPSE"))
(setvar "PELLIPSE" 1)
(setq CLA (getvar "CLAYER"))
(if (/= CLA LA)
(setvar "CLAYER" LA)
)
(command ".ELLIPSE"
"C"
(trans CEN 0 1)
(trans END_P1 0 1)
(trans END_P2 0 1)
)
(setq K (1+ K))
(setvar "PELLIPSE" PELMODE)
(entdel ENT)
(if (/= CLA (getvar "CLAYER"))
(setvar "CLAYER" CLA)
)
(if
(and LT
(/= (DXF 6 (tblsearch "LAYER" LA)) LT)
)
(progn (command ".CHPROP" "L" "" "LT" LT "")
(command ".PEDIT" "L" "L" "ON" "")
)
)
)
)
)
(setq M (1+ M))
)
(ssadd (entlast) converted)

(setq I (1+ I))

)
)
)
(command "select" converted "")

(setq *ERROR* OLDERR)
(command ".UNDO" "E")
(if OS
(setvar "OSMODE" OS)
)
(setvar "CMDECHO" CMD)
(princ)
(sssetfirst nil converted)
(ssget "_I")
)

;; 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:e2p ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:e2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:e2p)

Advertisements