I made a routine that handles all kind of entities you listed. Even blocks. But that's an issue, because the routine you've found is very slow. So this ability is commented out (see the blue) and blocks are exploded to get its lines and texts.
The routine is quite simple, you you can manage to make minor adjustments by yourself.
(vl-load-com)
; Required ExpressTools
(defun c:BG ( / *error* sel ss sst i enl sse)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(mapcar 'setvar *BG-VAR* *BG-VAL*)
(setq *BG-doc* nil *BG-VAR* nil *BG-VAL* nil *BG-enl* nil)
(princ))
(if (and (setq sel (ssget "_:L" '((0 . "*TEXT,*POLYLINE,*LEADER,DIMENTION,INSERT,SPLINE,LINE,ARC,CIRCLE"))))
(setq *BG-enl* (entlast))
(setq ss (ssadd))
)
(progn
(vla-startundomark (setq *BG-doc* (vla-get-activedocument (vlax-get-acad-object))))
(setq *BG-VAL* (mapcar 'getvar (setq *BG-VAR* '(CMDECHO OSMODE CLAYER DELOBJ PEDITACCEPT PICKSTYLE))))
(mapcar 'setvar *BG-VAR* '(1 0 "0" 3 1 0))
(setq enl (entlast))
(command "_.COPY" sel "" '(0 0 0) '(0 0 0))
(while (setq enl (entnext enl))
(ssadd enl ss))
(if (setq sst (acet-ss-ssget-filter ss '((0 . "*LEADER,DIMENTION,INSERT"))))
(progn
(initcommandversion)
(command "_.EXPLODE" sst ""))) ; lwpolylines,lines,*text,solid,insert
(setq enl *BG-enl* ss (ssadd))
(while (setq enl (entnext enl))
(if (entget enl) (ssadd enl ss))) ; revised ss - cleard of removed ents and added new ones
(if (setq sst (acet-ss-ssget-filter ss '((0 . "SOLID"))))
(command "_.ERASE" sst ""))
(if (setq sst (acet-ss-ssget-filter ss '((0 . "CIRCLE"))))
(:circle2polyline sst)) ; lwpolylines
(if (setq sst (acet-ss-ssget-filter ss '((0 . "SPLINE"))))
(repeat (setq i (sslength sst))
(command "_.SPLINEDIT" (ssname sst (setq i (1- i))) "_Polyline" 10))) ; lwpolylines
(if (setq sst (acet-ss-ssget-filter ss '((0 . "LINE,ARC"))))
(command "_.PEDIT" "_Multiple" sst "" "")) ; lwpolylines
;;; (if (and (setq sst (acet-ss-ssget-filter ss '((0 . "INSERT"))))
;;; (setq *toperror* *error*))
;;; (repeat (setq i (sslength sst))
;;; (:ExternalContourOfObjects (setq sse (ssadd (ssname sst (setq i (1- i))))))))
(setq enl *BG-enl* ss (ssadd))
(while (setq enl (entnext enl))
(if (entget enl) (ssadd enl ss))) ; revised ss - cleard of removed ents and added new ones
(if (setq sst (acet-ss-ssget-filter ss '((0 . "*POLYLINE"))))
(command "_.PEDIT" "_Multiple" sst "" "_Width" 1 ""))
(if (setq sst (acet-ss-ssget-filter ss '((0 . "*TEXT"))))
(progn
(acet-setvar (list "acet_textmask_masktype" "Solid" 3)) ; Save the mask type
(acet-setvar (list "acet_textmask_maskcolor" 42 3)) ; and the color
(sssetfirst nil sst))
(vla-sendcommand *BG-doc* (strcat "TEXTMASK\rP\r\r\r\r(BackgroundFinish)\r\r" (chr 27))))
(BackgroundFinish))
))
(princ)
)
; ---
(defun BackgroundFinish (/ *error* ss sst enl)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(mapcar 'setvar *BG-VAR* *BG-VAL*)
(vla-endundomark *BG-doc*)
(setq *BG-doc* nil *BG-VAR* nil *BG-VAL* nil *BG-enl* nil *toperror* nil)
(princ))
; ----
(if *BG-enl*
(progn
(setq enl *BG-enl* ss (ssadd))
(while (setq enl (entnext enl))
(if (entget enl) (ssadd enl ss)))
(command "_.-LAYER" "_T" "0-BACKGROUND" "_U" "0-BACKGROUND" "_M" "0-BACKGROUND" "C" 42 "0-BACKGROUND" ""
"_.CHPROP" ss "" "_Layer" "0-BACKGROUND" ""
"_.DRAWORDER" ss "" "_Back"
"_.REGENALL")
(if (setq sst (acet-ss-ssget-filter ss '((0 . "*TEXT,INSERT"))))
(command "_.ERASE" sst ""))
(*error* "end")))
(princ)
)
;; Written by Kent Cooper
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/circle-to-polyline-circular-polyline-to-circle/m-p/5520233/highlight/true#M330236
;; Mods by BeekeeCZ to make it subfunc
(defun :circle2polyline (csel / conv cir cdata cctr crad pdata ssnew)
(if (and csel ; User selection
(setq ssnew (ssadd)))
(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
(ssadd (entmakex (append '((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)]
)))
ssnew)
(entdel cir)))
ssnew)
;; --------------------------------------------------------------------------------------------------------------------------------------
;;; ! *********************************************************
;;; ! lib:IsPtInView *
;;; ! *********************************************************
;;; ! ????????? ????????? ?? ????? ? ??????? ?????? *
;;; ! Auguments: 'pt' — ????? ??? ??????? ? ???!!! *
;;; ! Return : T ??? nil ???? 'pt' ? ??????? ?????? ??? ??? *
;;; ! *********************************************************
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR")
Y_Len (getvar "VIEWSIZE")
SSZ (getvar "SCREENSIZE")
X_Pix (car SSZ)
Y_Pix (cadr SSZ)
X_Len (* (/ X_Pix Y_Pix) Y_Len)
Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
Uc (polar Lc 0.0 X_Len)
Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len))
)
(if (and (> (car pt) (car Lc))
(< (car pt) (car Uc))
(> (cadr pt) (cadr Lc))
(< (cadr pt) (cadr Uc))
)
T
nil
)
)
(defun DTR (a) (* pi (/ a 180.0)))
(defun RTD (a) (/ (* a 180.0) pi))
;; ! **********************************************************
;; ! lib:Zoom2Lst *
;; ! **********************************************************
;; ! Function : Zoom ?????? ?????? ????? *
;; ! Arguments: 'vlist' — ?????? ????? ? ???!!!! *
;; ! ????????? ?????, ????? ??? ????? ???? ????? *
;; ! Returns : t — ???? ???????????? nil — ??? *
;; ! **********************************************************
(defun lib:Zoom2Lst (vlist / bl tr Lst OS)
(setq Lst (lib:pt_extents vlist)
bl (car Lst)
tr (cadr Lst)
)
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn (command "_.Zoom"
"_Window"
(trans bl 0 1)
(trans tr 0 1)
"_.Zoom"
"0.95x"
)
T
)
NIL
)
)
;; ! ************************************************************
;; ! lib:pt_extents *
;; ! ************************************************************
;; ! Function : ?????????? ??????? MIN, MAX X,Y,Z ?????? ????? *
;; ! Argument : 'vlist' — ?????? ????? *
;; ! Returns : ?????? ????? (??????? ?????????) *
;; ! ************************************************************
(defun lib:pt_extents (vlist / tmp)
(setq tmp
(mapcar
'(lambda (x) (vl-remove-if 'null x))
(mapcar
'(lambda (what)
(mapcar '(lambda (x)
(nth what x)
)
vlist
)
)
'(0 1 2)
)
)
) ;_setq
(list
(mapcar
'(lambda (x)
(apply 'min x)
)
tmp
)
(mapcar '(lambda (x) (apply 'max x)) tmp)
)
) ;_defun
;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30724Ed
;External contour of objects
(defun :ExternalContourOfObjects (sel / *error* blk obj MinPt MaxPt hiden
pt pl unnamed_block isRus tmp_blk adoc
blks lays lay oname sel csp loc
sc ec ret DS osm OS)
(defun *error* (msg)
(mapcar '(lambda (x)
(vla-put-Visible x :vlax-true))
hiden)
(if (and tmp_blk
(not (vlax-erased-p tmp_blk))
(vlax-write-enabled-p tmp_blk))
(vla-Erase tmp_blk))
(if OS (setvar 'OSMODE OS))
(foreach x loc (vla-put-lock x :vlax-true))
(*toperror* msg)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if
(zerop (getvar "WORLDUCS"))
(progn
(vl-cmdf "_.UCS" "")
(vl-cmdf "_.Plan" "")))
(setq isRus (= (getvar "SysCodePage") "ANSI_1251")
adoc (vla-get-ActiveDocument (vlax-get-acad-object))
blks (vla-get-blocks adoc)
lays (vla-get-layers adoc))
(if isRus
(princ "\n???????? ??????? ??? ?????????? ???????")
(princ "\nSelect objects for making a contour")
)
(if sel
(progn
(setq sel
(mapcar 'vlax-ename->vla-object
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex sel))
)
)
)
(setq csp
(vla-objectidtoobject
adoc
(vla-get-ownerid (car sel))
)
)
(setq unnamed_block
(vla-add (vla-get-blocks adoc)
(vlax-3d-point '(0. 0. 0.))
"*U"
)
)
(foreach x sel
(setq oname
(strcase (vla-get-objectname x))
lay
(vla-item lays (vla-get-layer x))
)
(if (= (vla-get-lock lay) :vlax-true)
(progn
(vla-put-lock lay :vlax-false)
(setq loc (cons lay loc))
)
)
(cond
((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION"))
nil
)
((= oname "ACDBBLOCKREFERENCE")
(vla-InsertBlock
unnamed_block
(vla-get-insertionpoint x)
(vla-get-name x)
(vla-get-xscalefactor x)
(vla-get-yscalefactor x)
(vla-get-zscalefactor x)
(vla-get-rotation x)
)
(setq blk (cons x blk))
)
(t (setq obj (cons x obj)))
)
) ;_foreach
(setq lay
(vla-item lays (getvar "CLAYER"))
)
(if
(= (vla-get-lock lay) :vlax-true)
(progn (vla-put-lock lay :vlax-false)
(setq loc (cons lay loc))
)
)
(if obj
(progn
(vla-copyobjects
(vla-get-activedocument
(vlax-get-acad-object)
)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length obj)))
)
obj
)
)
unnamed_block
)
)
)
(setq obj (append obj blk))
(if obj
(progn
(setq tmp_blk (vla-insertblock
csp
(vlax-3d-point '(0. 0. 0.))
(vla-get-name unnamed_block)
1.0
1.0
1.0
0.0
)
)
(vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt) ;_??????? ?????
(setq MinPt (vlax-safearray->list MinPt)
MaxPt (vlax-safearray->list MaxPt)
DS (max (distance MinPt (list (car MinPt) (cadr MaxPt)))
(distance MinPt (list (car MaxPt) (cadr MinPt)))
)
DS (* 0.2 DS) ;1/5
DS (max DS 10)
MinPt (mapcar '- MinPt (list DS DS))
MaxPt (mapcar '+ MaxPt (list DS DS))
)
(lib:Zoom2Lst (list MinPt MaxPt))
(setq sset (ssget "_C" MinPt MaxPt))
(if sset
(progn
(setq hiden (mapcar 'vlax-ename->vla-object
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex sset))
)
)
hiden (vl-remove tmp_blk hiden)
)
(mapcar '(lambda (x) (vla-put-Visible x :vlax-false))
hiden
)
(setq pt (mapcar '+ MinPt (list (* 0.5 DS) (* 0.5 DS))))
(vl-cmdf "_.RECTANG" (trans MinPt 0 1) (trans MaxPt 0 1))
(setq pl (vlax-ename->vla-object (entlast)))
(setq sc (1- (vla-get-count csp)))
(if
(VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
'(lambda ()
(vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
(while (> (getvar "CMDACTIVE") 0) (command ""))
)
)
)
(if isRus
(princ "\n?? ??????? ????????? ??????")
(princ "\n")
)
)
(setq ec (vla-get-count csp))
(while (< sc ec)
(setq ret (append ret (list (vla-item csp sc)))
sc (1+ sc)
)
)
(setq ret (vl-remove pl ret))
(mapcar '(lambda (x) (vla-Erase x) (vlax-release-object x))
(list pl tmp_blk)
)
(setq pl nil
tmp_blk nil
)
(setq
ret (mapcar '(lambda (x / mipt)
(vla-GetBoundingBox x 'MiPt nil) ;_??????? ?????
(setq MiPt (vlax-safearray->list MiPt))
(list MiPt x)
)
ret
)
)
(setq ret (vl-sort ret
'(lambda (e1 e2)
(< (distance MinPt (car e1))
(distance MinPt (car e2))
)
)
)
)
(setq pl (nth 1 ret)
ret (vl-remove pl ret)
)
(mapcar 'vla-erase (mapcar 'cadr ret))
(mapcar '(lambda (x) (vla-put-Visible x :vlax-true))
hiden
)
(foreach x loc (vla-put-lock x :vlax-true))
(if isRus
(princ "\n?? ??????? ????????? ??????")
(princ "\n")
)
)
)
)
)
(VL-CATCH-ALL-APPLY
'(lambda ()
(mapcar 'vlax-release-object
(list unnamed_block tmp_blk csp blks lays)
)
)
)
)
) ;_if not
(foreach x loc (vla-put-lock x :vlax-true))
(vlax-release-object adoc)
(princ)
)
