Leaderboard

Your texts have to be single texts to be able to select them and besides that they should end with digit. (defun c:Test (/ int sel ent get lst) ;; Tharwat - Date: 26.Feb.2022 ;; (and (princ "\nSelect single texts : ") (setq int -1 sel (ssget '((0 . "TEXT") (1 . "*#")))) (or (< 1 (sslength sel)) (alert "Must select two texts at least to continue <!>") ) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent) lst (cons (list (atoi (substr (cdr (assoc 1 get)) 2)) (cdr (assoc 10 get)) ) lst ) ) ) (entmake (list '(0 . "LINE") (cons 10 (cadar (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k))))))) (cons 11 (cadar (reverse lst))) ) ) ) (princ) ) (vl-load-com)

I've fixed my attempt in a manner that it's debugged... So routine works as should, but then again - result is somewhat unexpected... So, continue to work on it... I hope it helps at least in some point... When you get it working, please inform us so that someone can find it useful in future... (defun c:replacefields2textsvalues ( / _getnestedfields _getmaintxtparentchild LM:popup ss i e fields l fieldx maintxtparentchild maintxtparent enx ent k ) (vl-load-com) ;;; load AciveX extensions (VLA functions) ;;; you can remove this line - it's only needed for LM:popup (sub function)... (defun _getnestedfields ( e / mainfoo enx historylist r ) (defun mainfoo ( enxxl / foo ) (defun foo ( enx / enxx enxxl ) (if (not (vl-position (cdr (assoc -1 enx)) historylist)) (progn (setq historylist (cons (cdr (assoc -1 enx)) historylist)) (if (vl-some '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx) (setq enxx (entget (cdr (assoc (vl-some '(lambda ( x ) (if (and (= (type (cdr x)) 'ename) (/= (car x) 330)) (car x))) enx) enx)) '("*"))) (setq enxx nil) ) (cond ( (equal (assoc 0 enx) (cons 0 "FIELD")) (setq r (cons enx r)) (if enxx (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x) '("*"))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx))) ) ) ( enxx (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x) '("*"))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx))) ) ) ) ) enxxl ) (if enxxl (mainfoo (apply 'append (mapcar '(lambda ( x ) (foo x)) enxxl))) ) ) (setq enx (entget e '("*"))) (mainfoo (list enx)) (if r (mapcar '(lambda ( x ) (cdr (assoc -1 x))) r) ) ) (defun _getmaintxtparentchild ( fieldx / enx enxx ) (setq enx fieldx) (while (not (wcmatch (cdr (assoc 0 (entget (cdr (assoc 330 enx)) '("*")))) "*ATT*,*TEXT")) (setq enx (entget (cdr (assoc 330 enx)) '("*"))) ) (setq enxx (cdr (assoc 330 enx))) (if enxx (list enxx (cdr (assoc -1 enx))) ) ) ;; Popup - Lee Mac ;; A wrapper for the WSH popup method to display a message box prompting the user. ;; ttl - [str] Text to be displayed in the pop-up title bar ;; msg - [str] Text content of the message box ;; bit - [int] Bit-coded integer indicating icon & button appearance ;; Returns: [int] Integer indicating the button pressed to exit (defun LM:popup ( ttl msg bit / wsh rtn ) (if (setq wsh (vlax-create-object "wscript.shell")) (progn (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit))) (vlax-release-object wsh) (if (not (vl-catch-all-error-p rtn)) rtn) ) ) ) (if (ssget "_A" (list '(0 . "~VIEWPORT") '(60 . 0) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model")))) (progn (prompt "\nSelect objects on unlocked layer(s) - preferable is that you type here \"ALL\" in order to make operation working on all visible entities of current/active space/layout...") (if (setq ss (ssget "_:L")) (progn (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (if (= (cdr (assoc 0 (entget e '("*")))) "FIELD") (setq fields (cons e fields)) (if (setq l (_getnestedfields e)) (setq fields (append fields l)) ) ) ) (setq k 0) ;;; (princ fields) ;;; if you want to see if something was collected - (0 . "FIELD") enitites... (foreach field fields (setq fieldx (entget field '("*"))) (setq maintxtparentchild (_getmaintxtparentchild fieldx)) (if (setq maintxtparent (car maintxtparentchild)) (progn (setq enx (entget maintxtparent '("*"))) ;;; first processing operation ;;; (setq enx (if (assoc 1 enx) (subst (assoc 1 fieldx) (assoc 1 enx) enx) (append enx (list (assoc 1 fieldx))))) (setq enx (vl-remove-if '(lambda ( x ) (eq (cdr x) (cadr maintxtparentchild))) enx)) (entupd (cdr (assoc -1 enx))) ;;; second processing operation ;;; (if (not (equal enx (entget (cdr (assoc -1 enx)) '("*")))) ;;; change didn't happen, so proceed to next procedure... ;;; (progn (entmake (append (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")) (list (assoc 1 fieldx)) (vl-remove-if '(lambda ( x ) (vl-position (car x) '(0 1 5 100 330))) enx))) (entdel (setq ent (cdr (assoc -1 enx)))) (if (vlax-erased-p ent) (setq k (1+ k)) ) ) (setq k (1+ k)) ) ) ) ) (prompt (strcat "\Processed total : " (itoa k) " FIELD entities (nested or not)...")) ) (progn (prompt "\nNothing selected...") (if (= 4 (LM:popup "REPLACE FIELDS VALUES WITH TEXTUAL VALUES" "Choose option : " 53)) (c:replacefields2textsvalues) ) ) ) ) (prompt "\nNo visible objects detected in DWG... Draw or append some objects and restart routine next time...") ) (princ) )

;;; Written by Doug Broad ;;; If value given 'to' argument is a real, a real is returned. ;;; Rounds up to nearest multiple of 'to' real or integer. (defun roundup (value to / try) (setq to (abs to) try (+(* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))to) ) (if(eq (+ 0.1 try) (+ 0.1 value to))(- try to) try) ) ; examples: ; Command: (roundup 0.00001 2) ; 2 ; Command: (roundup 30.01 5) ; 35 ; Command: (roundup 30 5) ; 30 (roundup 0.00001 2) returns 2

please test it . It make region on REGION-POLY layer . If need all region can be deleted ;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA ;;; Copyleft 1995-2022 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM ;; ; ---------------------------------------------------------------------- ; DISCLAIMER: Gabriel Calos De Vit Disclaims any and all liability for any damages ; arising out of the use or operation, or inability to use the software. ; FURTHERMORE, User agrees to hold Gabriel Calos De Vit harmless from such claims. ; Gabriel Calos De Vit makes no warranty, either expressed or implied, as to the ; fitness of this product for a particular purpose. All materials are ; to be considered ‘as-is’, and use of this software should be ; considered as AT YOUR OWN RISK. ; ---------------------------------------------------------------------- ;;************************************************************ ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* (DEFUN VAR->LST (VARIANT#) ;_01 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE VARIANT#)) ) ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* ;;;center-text-centroid ;;;(setq obj POLi) (DEFUN &-REGION/OBJ (OBJ) ;_ 01 (IF (= (TYPE OBJ) 'ENAME) (SETQ OBJ (VLAX-ENAME->VLA-OBJECT OBJ) ) ) (SETQ LISTA (LIST OBJ)) (ERRORTRAP (QUOTE (SETQ REGION# (CAR (VLAX-INVOKE MODEL "addregion" LISTA))))) REGION# ) ;;************************************************************ (DEFUN G-COORD-->LIST/OBJ (OBJ / CONT END-PAR PTOS-POLY) ;-001 (DEFUN CONT0 () ;-0001 (SETQ CONT 0) ) ;_defun cont0 (DEFUN CONT1 () ;-0001 (SETQ CONT (1+ CONT)) ) (IF (= (TYPE OBJ) 'ENAME) (SETQ OBJ (VLAX-ENAME->VLA-OBJECT OBJ)) ) ;_ convierte una ename en vlaobject (SETQ PTOS-POLY-LST NIL) (SETQ END-PAR (VLAX-CURVE-GETENDPARAM OBJ)) (CONT0) (REPEAT (1+ (FIX END-PAR)) (SETQ PTOS-POLY (VLAX-CURVE-GETPOINTATPARAM OBJ CONT)) (IF (/= (LENGTH PTOS-POLY) 3) (SETQ PTOS-POLY (REVERSE (CDR (REVERSE PTOS-POLY)))) (SETQ PTOS-POLY-LST (CONS PTOS-POLY PTOS-POLY-LST)) ) (CONT1) ) ;_ (REVERSE PTOS-POLY-LST) ) ;;************************************************************************************************************ ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/ (DEFUN &-CIRCLE-CO/P1-R1-CO (P1 R1 CO) (IF (= (TYPE P1) 'LIST) (SETQ P1 (VLAX-3D-POINT P1))) (IF (= CO NIL) (SETQ CO ACBYLAYER) ) (SETQ CIRCLE# (VLA-ADDCIRCLE MODEL P1 R1)) (VLA-PUT-COLOR CIRCLE# CO) CIRCLE# ) ;;************************************************************ ;;************************************************************ (DEFUN BUTLAST (LST) (REVERSE (CDR (REVERSE LST))) ) ;;;*************************************************************;;; (defun center-text-centroid (/ ) (VL-LOAD-COM) (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto- (SETQ MODEL (VLA-GET-MODELSPACE ADOC)) (SETQ SELECTIONSETS (VLA-GET-SELECTIONSETS ADOC)) (setq lay-coll (VLA-GET-LAYERS adoc)) (setq nub-nro-ss (ssget "_X" '((0 . "TEXT") (8 . "NUB")))) (setq nub-nro-obj-ss (VLA-GET-ACTIVESELECTIONSET adoc)) (command-s "-layer" "M" "region-poly" "") ;(setq nub-nro-obj (vla-item nub-nro-obj-ss 0)) (vlax-for nub-nro-obj nub-nro-obj-ss (setq nub-nro-xy (REVERSE (CDR (REVERSE (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-INSERTIONPOINT nub-nro-obj)) ) ;_ VLAX-SAFEARRAY->LIST ) ;_ REVERSE ) ;_ CDR ) ;_ REVERSE ) ;_ setq (VL-CMDF "-boundary" nub-nro-xy "") (setq bound (entlast)) (VL-CMDF "_region" bound "") (setq region (entlast)) (setq region-obj (EN2OB region)) (setq region-centroid-xyz (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-CENTROID region-obj))) ) ;_ setq (&-CIRCLE-CO/P1-R1-CO region-centroid-xyz 1.5 acgreen) ;;; (&-CIRCLE-CO/P1-R1-CO nub-nro-xy 0.5 acred) (setq bound-xy (mapcar 'BUTLAST (G-COORD-->LIST/OBJ bound))) (setq text@bound (ssget "wp" bound-xy '((0 . "TEXT")))) (setq text-10 (cdr (assoc 10 (entget (ssname text@bound 0))))) (&-CIRCLE-CO/P1-R1-CO text-10 1 acred) (VL-CMDF "_MOVE" text@bound "" text-10 region-centroid-xyz) ) ; end vlax-for ) ;end defun get-node-at-reducer (defun c:cent-text () (center-text-centroid) ) center text on centroid- move the block before.dwg

This will get the geometric center point. probably save some time without adding and deleting regions.