Leaderboard

Where layer transparency is concerned, this may be of interest - https://www.theswamp.org/index.php?topic=52473.msg574001#msg574001

PS: Someday you'll win one of those public tenders, and when that happens, I hope you'll come over here and have a coffee with one of us Good luck!

Hi @PGia I think this should meet your needs. I could say I wrote it from scratch just for you, but really, I also did it for myself. I had a good time revisiting old concepts. As I said, this is much easier to do with Map or Civil3D, creating topologies and manipulating them with the 'mnt*' functions. But writing this code has helped me prove that these tools can also be done in Lisp, with reasonably good results. The expressions are in my language. You'll have to translate them into yours. ;******************* G L A V C V S ******************* ;********************* F E C I T ********************* (defun c:spf>PGia (/ conj cj cjP ent n lstent en ex d pt i l lC lCs cE ltS ltV ltds s lSV actEtqs selR) (defun lSV (l / p r) (setq ltS (cons (list (setq s (vlax-ename->vla-object (car l))) (cadr l)) ltS) lCs (cons (list s (last l)) lCs)) (foreach x (reverse (cdr l)) (if p (if (not (member x ltds));ltds es la lista de los ya tocados (if (setq r (assoc p ltV)) (setq ltV (subst (list (car r) (+ (cadr r) (vla-get-area x))) r ltV) ltds (cons x ltds));ltV es una lista en que se asocia el identificador de las lineas contenedoras con la suma de la áreas de las contenidas (setq ltV (cons (list p (vla-get-area x)) ltV) ltds (cons x ltds)) ) ) ) (setq p x) ) ) (defun actEtqs (/ a b c e p pc l et tx) (foreach v (reverse ltS) (setq e (car v) p (cadr v) pc (last v)) (if (= (vla-get-layer e) "US") (setq l (cadr (assoc e lCs)) tx (vl-some '(lambda (x) (if (equal (cadr x) l) (vla-get-textstring (car x)))) ltS)) (setq tx nil) ) (if (/= (vla-get-layer e) "GEN") (vla-put-color p 6)) (vla-put-textstring e (strcat (if tx (strcat tx "-") "") (vla-get-textstring e) ":" (rtos (- (vla-get-area p) (if (setq a (assoc p ltV)) (cadr a) 0)) 2 2)) ) ) ) (defun selR (p / r s l lt en ex cj n o r4 f) (defun r2+ (p l r / i b) (vl-some '(lambda(g) (= 2 (setq r (if (foreach a (cons (last l) l) (if b (if (inters p (polar p g d) b (setq b a)) (setq i (not i))) (setq b a)) i) (+ r 1) r)))) '(0 1.5708 3.141592 4.71239) ) ) (if (setq cj (ssget "_F" (list p (list (car p) (+ (cadr p) (getvar "viewsize")))) (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)) ) ) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (if (r2+ p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))) 0) (progn (setq l (cons (vlax-ename->vla-object e) l)) (if (ssmemb e cjP) (ssdel e cjP))) ) ) ) (if l (vl-sort l '(lambda (a b) (< (vla-get-Area a) (vla-get-Area b))))) ) (setq en (getvar "extmin") ex (getvar "extmax") n -1 d (max (- (car ex) (car en)) (- (cadr ex) (cadr en))) ) (vla-zoomExtents (vlax-get-acad-object)) (setq cjP (ssget "x" (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)))) (if (setq conj (ssget "_X" '((0 . "TEXT") (8 . "GEN,US")))) (while (setq ent (ssname conj (setq n (1+ n)))) (setq lstent (entget ent) pt (cdr (assoc 10 lstent))) (if (setq l (selR pt)) (lSV (cons ent l)) (princ (strcat "\n*** Etiqueta " (cdr (assoc 1 lstent)) " huerfana"))) ) ) (if (> (sslength cjP) 0) (alert "ATENCION: Hay polilíneas sin asignar")) (alert (strcat "Numero de perímetros procesados: " (itoa (length ltS)))) (actEtqs) (princ) )

See attached code. 1. run the lisp in paper space. 2. the lisp prompt you to select a point on the block IN PAPER SPACE!! - click on the block. 3. click on the start point of the MLeader arrow - you are in paper space, no wories... 4. place the MLeader. 5. if you want to label another block go ahead. 6. to exit hit escape key or mouse right click. EDIT: the lisp works in model space as well. (defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1 (setq temperr *error*);store *error* (setq *error* trap1);re-assign *error* (setq osnp (getvar "OSMODE")) (setvar "OSMODE" 0) (setq tm (getvar "TILEMODE")) (princ "Select object in paper space,select start point of MLeader,exit with esc'") (while 1 (if (= tm 0);if in paper space (progn (getpoint) ;;get point in paper space on the target object (command "._MSPACE") (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space (setq ss (ssget ptms));;selction set of the object crossing the ptms point (setq obj(ssname ss 0)) (command "._PSPACE") );progn (progn ;in model space (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy (setq obj (car ensel)) ;set the block object to varaible );progn );if (setq obj1 (vlax-ename->vla-object obj)) (setq nam (vlax-get-property obj1 (if (vlax-property-available-p obj1 'effectivename) 'effectivename 'name ) ) ) (command "_mleader" "H" pause pause nam) );end while (setq *error* temperr) (princ) ) (defun trap1 (errmsg) (command "._PSPACE") (SETVAR "OSMODE" osnp) (princ) )

Nikon, you forgot to add open and closing brackets for v1 and v2... Like I said it should be : (atof v1) and (atof v2)...

Whereever in the code occurs v1 or v2, change them to (atof v1) and (atof v2)...

Very true. Glad to see you posting more Lee.

A slightly more complete version. Maybe it will be useful to someone someday. (defun c:GLAVCVSfibo (/ n cierraOtro p1 p2 p3 p4 i osmant cja f1 f2) (defun cierraOtro (f1 f2 / d ang) (setq d (+ f1 f2) ang (angle p2 p3) ) (command "_pline" (setq p1 p3) (setq p2 (polar p3 ang d)) (setq p3 (polar p2 (- ang i) d)) (setq p4 (polar p3 (- ang i i) d)) (polar p4 (- ang PI i) d) "") (command "_arc" "c" p4 p3 p1) (ssadd (entlast) cja) ) (setq n (getint "\nFibonaciCAD: Specifies number of sequences: ")) (setq f1 0 f2 1 i (/ PI 2) osmant (getvar "osmode")) (setvar "osmode" 0) (command "_pline" (setq p1 '(0 0)) (setq p2 '(-1 0)) (setq p3 '(-1 1)) (setq p4 '(0 1)) '(0 0) "") (command "_arc" "c" p4 p3 p1 "") (setq cja (ssadd)) (ssadd (entlast) cja) (repeat (- n 1) (cierraOtro f1 f2) (setq f f2 f2 (+ f1 f2) f1 f) ) (command "_pedit" "_m" cja "" "" "_j" 0 "") (setvar "osmode" osmant) (princ) )

@Nikon You should keep one thing in mind: the actual number of iterations will be 1 more than you specify. I forgot to consider the first one, which is done before the loop. Therefore, you should change 'repeat n' to 'repeat (- n 1)'

Oh wait... Here's a script I wrote 15 years ago ; ; Fibonacci spiral ; (defun fib () (princ "\nThis command draws a Fibonacci spiral. On my computer the max number of lines is a bit less than 50") (setq number_of_lines (getint "\nDraw a Fibonacci spiral.\nHow many sides: ")) (setq insertPoint (list 0 0)) (setq previousInsertPoint (list 0 0)) (setq twoPointsBack (list 0 0)) (setq key 1) (repeat number_of_lines (progn ; length of the line (setq newLength (fibonacci key)) ; the newest line is drawn +90° of the previous line (setq remainder (rem key 4) ) (setq angle (* remainder (/ PI 2.0)) ) ; draw the line. Retrieve the secondary point (that point will be the insert point of the next line) (setq secondaryPoint (drawNewLine insertPoint angle newLength )) ; ARC (setq radius (distance previousInsertPoint insertPoint)) (setq center twoPointsBack) (setq start_angle (* (- remainder 1) (/ PI 2.0)) ) (setq end_angle angle) (entmake (entmake_arc center radius start_angle end_angle) ; listed properties of an arc. ready to entmake ) ;; prepare variables for new iteration (setq oldLength newLength) (setq twoPointsBack previousInsertPoint) (setq previousInsertPoint insertPoint) (setq insertPoint secondaryPoint) (setq key (+ 1 key) ) ) ) (princ) ) (defun drawNewLine (insertPoint angle distance / secondaryPoint) (setq secondaryPoint (polar insertPoint angle distance)) (entmake (mapcar 'cons (list 0 100 8 62 100 10 11) (list "LINE" "AcDbEntity" "0" 3 "AcDbLine" insertPoint secondaryPoint) ) ) secondaryPoint ) (defun fibonacci (index / new_value) (setq new_value nil) ; New value. Each value (except the first two) is the sum of two previous values. results in: 1 1 2 3 5 8 13 21 ... (setq val_a 1) ; 1 value back (setq val_b 1) ; 2 values back (if (= index 0) (progn ) ) (if (= index 1) (progn (setq new_value 1) ) ) (if (= index 2) (progn (setq new_value 1) ) ) (if (> index 2) (progn (setq i 0) (repeat (- index 2) (progn (setq new_value (+ val_a val_b)) ; preapre for new iteration (setq val_a val_b) (setq val_b new_value) ) ) ) ) new_value ) (defun entmake_arc (Center Radius start_angle end_angle / opts) (setq opts (mapcar 'cons (list 0 100 100 10 40 210 100 50 51) (list "ARC" "AcDbEntity" "AcDbCircle" Center Radius '(0 0 1) "AcDbArc" start_angle end_angle ) ) ) ;(std-%entmake-template elist opts '(10 40 50 51)) opts ) (defun c:fib () (fib) )

You should change "pol" to "_pline"

Maybe something like this? (defun c:GLAVCVSfibo (/ n cierraOtro p1 p2 p3 p4) (defun cierraOtro (f1 f2) (setq d (+ f1 f2) ang (angle p2 p3) ) (command "pol" p3 (setq p2 (polar p3 ang d)) (setq p3 (polar p2 (- ang i) d)) (setq p4 (polar p3 (- ang i i) d)) (polar p4 (- ang PI i) d) "") ) (setq n (getint "\nFibonaciCAD: Specifies number of sequences: ")) (setq f1 0 f2 1 i (/ PI 2)) (command "pol" '(0 0) (setq p2 '(-1 0)) (setq p3 '(-1 1)) '(0 1) '(0 0) "") (repeat n (setq f f2 f2 (+ f1 f2) f1 f) (cierraOtro f1 f2) ) (princ) )

Look for my attachments posted in this topic... (You have to be logged to download attached files...) Here is link : https://www.theswamp.org/index.php?topic=12813.255

EDIT: oh wait ... I got a mistake somewhere. It makes a spiral, but not the Fibonacci spiral exactly. (vl-load-com) ;; https://www.cadtutor.net/forum/topic/75640-arc-start-and-end-point-help/ ;; Arc Endpoints - Lee Mac ;; Returns the endpoints of an Arc expressed in WCS (defun LM:ArcEndpoints ( ent / cen nrm rad ) (setq ent (entget ent) nrm (cdr (assoc 210 ent)) cen (cdr (assoc 010 ent)) rad (cdr (assoc 040 ent)) ) (mapcar (function (lambda ( ang ) (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0) ) ) (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun drawArc (cen rad sAng eAng) (entmakex (list (cons 0 "ARC") (cons 10 cen) (cons 40 rad) (cons 50 sAng) (cons 51 eAng))) ) (defun deg2rad (deg) (* pi (/ deg 180.0)) ) (defun c:Fibonacci ( / it ind arc fib fib_prev cen prev_cen rad sAng eAng endpts) (setq it (getint "\nHow many iterations (above 2 please): ")) ;; iteration 1 (setq ind 1) (setq fib_prev 1) (setq fib 1) (setq cen (list 0.0 0.0) rad 1.0 sAng 0 eAng (deg2rad 90) ) (setq arc (drawArc cen rad sAng eAng)) ;; iteration 2 (setq ind 2) (setq fib_prev 1) (setq fib 1) (setq cen (list 0.0 0.0) rad 1.0 sAng (deg2rad 90) eAng (deg2rad 180) ) (setq arc (drawArc cen rad sAng eAng)) ;; iteration 3 and further (while (<= ind it) (setq ind (+ ind 1)) (setq fib_prev fib) (setq fib (+ fib_prev fib)) (setq endpts (LM:ArcEndpoints arc)) (setq sAng eAng ;; start angle is the previous end angle eAng (+ eAng (deg2rad 90)) ;; end angle: add 90° cen (polar (nth 1 endpts) (+ eAng (deg2rad 90)) fib) ;; new center: endpoint of the previous arc; polar => 90° extra of endArc, dist of fibonacci length rad fib ) (setq arc (drawArc cen rad sAng eAng)) ) (princ) )

You're welcome . This part of code can be just an option/alternative to get a attribute position (it's not neccessery). (setq pt_attdef_one (polar pt 0.785 10) ;; 0.785 is the angle of 45 degree, 10 is the length (you can change the angle and length) pt_attdef_second (polar pt 5.497 10) ;; 5.497 is the angle of 315 degree, 10 is the length (you can change the angle and length) ) I think if both values nonzero 72 2 and 74 3, or 72 for e.g 1 and 74 0, or 72 for e.g 0 and 74 1, the text insertion point values are ignored. Really don't know... P.S. Bitno je da radi sada

If values for 72 and 74 dxf codes supplied, you will get this (link): If group 72 and/or 74 values are nonzero, then the text insertion point values are ignored and new values are calculated by AutoCAD based on the text alignment point and the length of the text string itself (after applying the text style). If you want to avoid this, than you can for the second attribut making according to insertation point (pt) do this "(cons 10 (cons 10 (list (car pt) (- (cadr pt) 0.3) (caddr pt)))" (where 0.3 is the text height), and you will get something like this and need to put (cons 74 0) in all attribut definition: If (cons 74 0) are non-zero value, I get this: Also, you can change (cons 70 0) to be visible, otherwise the values are not appears to be visible in drawing.

@GLAVCVS, just test it your code and it also works great . I started something new to writte and didn't have time to finish it, when everything is going to be done and tested, I will also post it. Just a little notice @GLAVCVS (picture 1 and 2): - picture 1: the total area need to be substracted from areas 1, 2, 3 and 4. - picture 2: the total2 area need to be substracted from areas 1 and 2, and the total1 area need to be substracted from areas 1, 2 and total2 (at this part I stopped writting the code). Agree with this part. From last post when I said "So, maybe to find a good organization in file (for e.g. layers names, closed polygons of polyline, TEXT /MTEXT formatting, entities in right layers, etc.)", I meant on that.

Finally, the code assumes that the perimeters in the drawing will be closed LWpolylines, the labels will be text, and the layers will be the same as in the example you attached. If any of these conditions are not met, it won't work.

How does it work? Although it may seem like there's little code, it does a lot more than meets the eye: - associates each polyline with the text inside it - calculates the area of each perimeter and associates it with the text inside, taking into account the secondary perimeters - changes the color of the secondary perimeters and adds a reference to the main perimeter to their labels - checks whether all perimeters and labels have been found and leaves a warning if this hasn't happened There are a few more details I've left unresolved so as not to go on about this any longer (because it probably doesn't matter) but that you should keep in mind: - If there is more than one label inside a perimeter, it will associate the same information with both and won't give you any warning - If there is an unlabeled perimeter, it will leave a warning but won't tell you where it is.

After that, all that's left is to identify which of the objects created by 'boundary' matches the rectangle. '(ssadd (entlast) dm)' is useless because it might select the wrong polyline. I would use, for example: (setq f (ssget "_X" (list '(0 . "LWP*") '(-4 . "=,=,*") (list 10 (car p1) (cadr p1) 0.0))))

I think you misunderstood me. You should write: (setq m (polar p1 (angle p1 p2) (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))

You can calculate this using: (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))

Another thing to keep in mind is that calculating a point just 1 drawing unit from the bottom corner of the rectangle may cause "boundary" to not work correctly. You may want to calculate that point by applying the drawing distance equivalent to one pixel.

The function EXTRACTNUMBER has been added. The code works. Thanks!

Here is a similar code: Block name in text. EFF_NAME.lsp

THANKS A LOT! you are the best ! many thanks have a nice day

If you submit integers to the divide function, the result will be an integer. See help ... This is possible: remove the variable "op" from local variables, which could give: (defun c:CalcTwoTxt ( / ss1 ss2 val1 val2 key rslt inspt) (princ "\nSelect first text") (while (not (setq ss1 (ssget "_+.:E:S" '((0 . "*TEXT")))))) (princ "\nSelect second text") (while (not (setq ss2 (ssget "_+.:E:S" '((0 . "*TEXT")))))) (setq val1 (extractnumber (cdr (assoc 1 (entget (ssname ss1 0)))))) (setq val2 (extractnumber (cdr (assoc 1 (entget (ssname ss2 0)))))) (cond ((and val1 val2) (if (not op) (setq op "+")) (initget "* + - /") (setq key (getkword (strcat "\nSelect an operation [*/+/-/\/]? <" op ">: "))) (if key (setq op key)) (if (and (eq op "/") (member 0 val2)) (setq rslt 0.0) (setq rslt (apply (read op) (append val1 val2))) ) (initget 1) (setq inspt (getpoint "\nSpecify the insertion point of the result: ")) (command "_.TEXT" inspt "2.5" "0" (rtos rslt 2 2)) ) (T (princ "\No value found in text")) ) (prin1) )

Shouldn't it be better, for example, '(polar p1 0.79 1))'?

@maahee Are you sure that this point '(polar p1 (* pi 1.75) 1))' will lie inside the rectangle?

Hi @PGia Can you attach a larger drawing? I need to run some tests.

Easy solution NO CODE, draw a closed pline around your shapes, Type Bpoly, pick point between shapes and out side pline, a pline around outside of shapes should be there now erase outer plines, yes plines as bpoly adds one to outside.

Hi Maahee It's better if you attach a drawing

Hey @PGia, Try this new one: ; **************************************************************************************** ; Functions : UMTXT ; Description : Adding an Area value to the label/text of each closed polyline ; Author : SAXLLE ; Date : March 20, 2025 ; Update 1.0 : Added a substraction to get a total value of largest closed polyline ; Update date : March 21, 2025 ; **************************************************************************************** (prompt "\nTo run a LISP type: UMTXT") (princ) (defun c:UMTXT ( / old_nomutt ss len i area_with_entity_list area area_with_entity len_area_with_entity_list j max_val substracted_area total_area ptlist select_text data_text new_txt k) (setq old_nomutt (getvar 'nomutt)) ;; Get a value from 'nomutt (setvar 'nomutt 1) ;; Set a value to be "1" to "supress" the default "Select objects:" from ssget (princ "\nSelect closed POLYLINES:") (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))) ;; Select ONLY POLYLINES which are closed! "1" means "1 = Closed" len (sslength ss) ;; Length of selection set i 0 ;; 1. iterator area_with_entity_list (list) ;; In this list will be stored joined value of an Area and entity (e.g. (500 . <Entity name: 2ed1289fd60>)) ) (while (< i len) (setq area (vlax-get-property (vlax-ename->vla-object (ssname ss i)) 'Area) ;; Get an Area from closed POYLINE area_with_entity (cons area (ssname ss i)) ;; Join the value of Area with entity name area_with_entity_list (cons area_with_entity area_with_entity_list) ;; Create a list of value with Area and entity name ) (setq i (1+ i)) ;; Adding 1+ to iterator "i" to repeat iterating through selection set "ss" ) (setq area_with_entity_list (vl-sort area_with_entity_list (function (lambda (x1 x2) (< (car x1) (car x2))))) ;; Sorting list from MIN to MAX area with entity len_area_with_entity_list (length area_with_entity_list) ;; Length of elements in the variable "area_with_entity_list" j 0 ;; 2. iterator with FIX value "0" ) (setq max_val (car (nth 0 area_with_entity_list))) ;; Get the first value as MAX value of an Area (repeat (setq len_max (length area_with_entity_list)) ;; Finding a MAX value of an Area from variable "area_with_entity_list" (if (<= max_val (car (nth (1- len_max) area_with_entity_list))) (setq max_val (car (nth (1- len_max) area_with_entity_list)) len_max (1- len_max) ) (setq max_val max_val) ) ) (setq substracted_area 0) ;; Set "substracted_area" to 0 (repeat (setq len_max (length area_with_entity_list)) ;; Finding a "substracted_area" from variable "area_with_entity_list" which are going to be substracted from variable "max_val" (if (> max_val (car (nth (1- len_max) area_with_entity_list))) (setq result (+ substracted_area (car (nth (1- len_max) area_with_entity_list))) substracted_area result len_max (1- len_max) ) (setq len_max (1- len_max)) ) ) (setq total_area (- max_val substracted_area)) ;; This is a total area for the largest closed polyline, where the rest Area from closed poylines substracted from variable "max_val" (repeat len_area_with_entity_list (setq ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cdr (nth j area_with_entity_list))))) ;; Get a vertices from closed POLYLINE select_text (ssget "_WP" ptlist '((0 . "*TEXT,MTEXT"))) ;; Select ONLY TEXT or MTEXT entities ) (if (/= select_text nil) ;; 1. progn with WINDOW POLYGON "_WP" (progn ;; start cond (cond ;;1. cond ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1 (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (nil) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ) ) ;; end 1. cond ;;2. cond ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2 (setq k (- (sslength select_text) 1)) ;; 3. iterator (repeat (sslength select_text) (if (/= k -1) (progn (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (setq k (1- k)) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text" ) ) ) ) ) (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ;; end 2. cond ) ;; end cond ) ;; end 1. progn ;; 2. progn with FENCE "_F" (progn (setq select_text (ssget "_F" ptlist '((0 . "*TEXT,MTEXT")))) ;; Select ONLY TEXT or MTEXT entities ;; start cond (cond ;;1. cond ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1 (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (nil) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ) ) ;; end 1. cond ;;2. cond ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2 (setq k (- (sslength select_text) 1)) ;; 3. iterator (repeat (sslength select_text) (if (/= k -1) (progn (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (setq k (1- k)) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text" ) ) ) ) ) (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ;; end 2. cond ) ;; end cond ) ;; end 2. progn ) ;; end if ) ;; end repeat (setvar 'nomutt old_nomutt) ;; Restore old value to 'nomutt (prompt "\nAdding area to the labels has been done!") (princ) ) I'v been tested this new one lisp on the both drawing which are you uploaded, and get great result (picture 1 and picture 2). Picture 1. Picture 2. I hope you will get satisfied. Notice: It will only concate the label/text value of closed polyline with an Area of that closed polyline, for opened polylines, nothing is going to happen. Best regards.

To keep the dimension associated with the measurement, I'd create a new style identical to the current one, only without the diameter symbol. Change the name by one letter so it shows up next to the original in the list, and you'll remember to update both styles if that becomes necessary.

It's really hard to consider all possible situations in code. I spent a while working on it yesterday afternoon, but I didn't have time to finish. I enjoyed doing it because it's helping me remember some things I'd forgotten. I'll post the result as soon as I can.

@vindicate Turnoff the Dynamic UCS and apply @Cad64 approach using construction line.

Now I see what you did here, you should have to select all the polylines. I've restructured the routine to notify user to select the largest polyline. (defun c:pl_area (/ bb e eng h ll lst lst2 pt pts n nv ss sst str ur v raycast) ;;LeeMac (defun raycast ( p l ) (= 1 (logand 1 (length (vl-remove 'nil (mapcar '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b)) (cons (last l) l) l ) ) ) ) ) ) (if (setq e (car (entsel "\nSelect largest polyline: "))) (progn (setq eng (entget e) bb (mapcar '(lambda (x)(trans (cdr x) e 1))(vl-remove-if-not '(lambda (x)(eq (car x) 10)) eng)) ss (ssget "wp" bb '((0 . "LWPOLYLINE"))) sst (ssget "cp" bb '((0 . "MTEXT,TEXT"))) ) (cond ((null ss)(setq ss (ssadd))(ssadd e ss)) ((not (ssmemb e ss))(ssadd e ss)) ) (if (eq (sslength ss)(sslength sst)) (progn (repeat (setq n (sslength ss)) (setq n (1- n) e (ssname ss n) v (vlax-ename->vla-object e) a (vla-get-area v) lst (cons (cons a e) lst) ) ) (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))) (repeat (setq n (sslength sst)) (setq n (1- n) e (ssname sst n) v (vlax-ename->vla-object e) lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2) ) ) (foreach a lst (setq eng (entget (cdr a)) pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng)) str (rtos (car a) 2 4) ) (foreach pt lst2 (if (raycast (cdr pt) pts) (progn (if (eq (vla-get-objectname (car pt)) "AcDbMText") (vlax-put (car pt) 'textstring (strcat (vlax-get (car pt) 'textstring) "\\P= " str) ) (progn (setq nv (vla-copy (car pt)) h (* 1.3333 (vla-get-height nv))) (vlax-put nv 'textstring str) (vlax-put nv 'insertionpoint (list (car (cdr pt)) (- (cadr (cdr pt)) h) (caddr (cdr pt)))) ) ) (setq lst2 (vl-remove pt lst2)) ) ) ) ) ) (prompt "\nPolyline and text counts do not match. Check selection.") ) ) ) (princ) )

Enter the diameter value in the Text overide box of the properties panel. Note that the dimension will no longer be associative.

Can you not just click on the dim and in properties just remove the %%d or the dia symbol. You can overwrite any dim, if you replace the text with <> it should revert back to the actual distance.

Its no good even if you could convert the TTF to a shx you would still have to send it to all 50 people, so the TTF is a custom font ? Not a standard one within Windows which has lots. You can copy a font and paste to c:\windows\fonts it should auto install. Like @Steven P why not just replace with some thing very close. If you open explorer and go to c:\windows\fonts you will see what the font looks like or you can dbl click it, and it will show an example of the font in words. If you have dual screens will help to compare. There is one TTF I know of which is Arch.TTF which s a freehand font and used a lot.

pkenewell, yes, only going to be asking the tricky ones! It is all working now I think

Yes - I was thinking MLEADER instead of LEADER. Didn't realize Steven P was talking about the old style Leaders. The old leaders were "governed" by dim variables.

It seems perfectly fine and much better. (vla-get-ActiveDocument (vlax-get-acad-object)) - this can be set to a variable.

(defun NearestINT (num f / i r) ;; num - real / integer ;; f - fuzz (setq i (float (fix num)) r (- num i)) (cond ((< r f) i) ((> r (abs (1- f))) (1+ i)) (T num) ) ) (defun add_vtx (obj add_pt ent_name / bulg) (vla-addVertex obj (1+ (fix add_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) ) ) ) ) (setq bulg (vla-GetBulge obj (fix add_pt))) (vla-SetBulge obj (fix add_pt) (/ (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) ) ) (vla-update obj) ) (defun c:div-vertex_po ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len1 seg_len2 div l_div l) (princ "\nSelect polylines.") (while (null (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelect is empty, or isn't POLYLINE!") ) (initget 7) (setq max_l (getdist "\nMax length between vertex: ")) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj_vla (vlax-ename->vla-object ent) pr (fix (vlax-curve-getEndParam ent)) ) (repeat (fix (vlax-curve-getEndParam ent)) (setq dist_end (vlax-curve-GetDistAtParam ent pr) dist_start (vlax-curve-GetDistAtParam ent (setq pr (1- pr))) seg_len1 (- dist_end dist_start) seg_len2 (nearestint seg_len1 1e-4) div (if (equal (fix seg_len2) seg_len2 0.0)(fix (/ seg_len2 max_l))(1+ (fix (/ seg_len2 max_l)))) l_div (/ seg_len2 div) l l_div ) (while (< l seg_len2) (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent) (setq l (+ l l_div)) ) ) ) (prin1) ) Hi enthralled, please try the 3rd revision.

Or just to - (setq col (cond ((< area1 399.5) "255,121,77") ((< area1 449.5) "242,95,171") ((< area1 549.5) "253,134,206") ((< area1 599.5) "253,206,243") ((< area1 699.5) "242,187,166") ("253,237,206") ) )

Presumably you're assuming an MLEADER as opposed to a LEADER? For a LEADER entity, an arrowhead size override is set within the extended entity data, e.g.: (defun c:myleader ( / p q s ) (if (and (setq p (getpoint "\n1st point: ")) (setq q (getpoint "\n2nd point: " p)) (setq s (getdist "\nSpecify arrowhead size: ")) ) (progn (regapp "ACAD") (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") (cons 10 (trans p 1 0)) (cons 10 (trans q 1 0)) (list -3 (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (cons 1040 s) '(1002 . "}") ) ) ) ) ) ) (princ) )

Hello everyone. I don't want to take sides. But I think Mr. GLVCVS is right. In my office, we've sometimes had to work with closed polylines inside other closed polylines. This is a possibility that needs to be taken into account in some cases. Although I don't know if it's necessary in this case.

You could try this too: (defun c:foo (/ a d) (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a)))) ) (vlax-for b (vla-get-blocks d) (if (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-for o b (vl-catch-all-apply 'vla-put-layer (list o "0")) (vl-catch-all-apply 'vla-put-color (list o 256)) ) ) ) (foreach l a (vlax-put l 'lock -1)) (vla-purgeall d) (vla-regen d acactiveviewport) (princ) )

I am thinking you might use this from Lee Mac to get a list of nested blocks and work from there: https://lee-mac.com/extractnestedblock.html I think this is the related part of the code ;;https://lee-mac.com/extractnestedblock.html ;;USe this line to select a block (enb:getreferences (cdr (assoc 2 (entget (car(entsel)))))) ; Use this to loop through the blocks, in this case it is making a list, in your case (ssget "_X") and modify assoc codes to by block / layer colouras and layer codes. (defun enb:getreferences ( blk / ent enx lst ) (if (setq ent (tblobjname "block" blk)) (foreach dxf (entget (cdr (assoc 330 (entget ent)))) (if (and (= 331 (car dxf)) (setq ent (cdr dxf)) (setq enx (entget ent)) (setq enx (entget (cdr (assoc 330 (reverse enx))))) ) (if (wcmatch (strcase (setq blk (cdr (assoc 2 enx)))) "`**_SPACE") (setq lst (cons (list ent) lst)) (setq lst (append (mapcar '(lambda ( l ) (cons ent l)) (enb:getreferences blk)) lst)) ;; Change this line to set colours / layers ) ) ) ) lst ) That might give you a start if you want to do some thinking

One way to do this would be to draw a temporary construction line from endpoint to endpoint. Then you can draw a circle at the midpoint of that line and then delete the line. Also, working in 2D wireframe mode, instead of Xray mode, makes it easier to work without the faces getting in the way.