Leaderboard

Too bad the 'MenuBar' is not present in AutoCAD-MAP-3D...

I appreciate all the effort. Thank you Emmanuel. Attaching the .lsp file to share with others: (DWH) DataExtraction With Handle This LISP Function will collect the properties of selected objects and export it as CSV File. • Command: DWH • Selection Set: POINT,*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS • Properties: TYPE, HANDLE, LAYER, HYPERLINK, COLOR, AREA, LENGTH • File Path: (C:\Users\ \Downloads) (DWH) Data With Handle.lsp

use textbox command.

If you look at 'entmod' to change the text, create your text as above. Example here based on AutoCAD help (select an entity to change), assoc 41 is for width factor (setq ed (entget (car (entsel)))) (setq ed (subst (cons 41 -NEWWIDTHFACTOR-) (assoc 41 ed) ed )) (entmod ed) though in your case (using entlast - the last entity) (setq ed (entget (entlast))) (setq ed (subst (cons 41 -NEWWIDTHFACTOR-) (assoc 41 ed) ed )) (entmod ed) (though it is slightly more efficient to use entmake to create the whole text including width factor, if it works this way, it works) EDIT Marko_Ribar is of course correct, however this way can be used on existing texts as the first snippet - so place the text, find bounding box area, alter width using entmod

I've found in my library something ab overlapping of TEXT(S), but it's *.VLX... Nevertheless, I am attaching it, so that you can test it in your example *.DWG... If you are satisfied with result, then just fine. I am OK, not author, but he/she would agree with me if it works as desired... HTH. M.R. TxtOverlap.VLX txtoverlap.txt

Here, check it now... (defun C:P2B (/ *error* atd ss base n pl ar ll ur mp att blk); = Polylines [to] Blocks (vl-load-com) (defun *error* (m) (if atd (setvar 'attdia atd) ) (if m (prompt m) ) (princ) ) (setq atd (getvar 'attdia)) (setvar 'attdia 0) (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1)))) (progn ; then (setq base 0 n -1) (while (tblsearch "block" (itoa (+ (1+ base) n))) (setq base (1+ base)) ); while (while (tblsearch "block" (itoa (+ base (1+ n)))) (setq n (1+ n)) ); while (setq n -1) (repeat (sslength ss) (setq pl (ssname ss (setq n (1+ n)))) (while (tblsearch "block" (itoa (+ (1+ base) n))) (setq base (1+ base)) ); while (setq ar (vlax-curve-getArea pl)) (vla-getBoundingBox (vlax-ename->vla-object pl) 'll 'ur) (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur))) (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur)) (command "_.attdef" "" "TAG" "" "" "_none" mp (getvar 'textsize) "") (setq att (entlast)) (command "_.block" (setq blk (itoa (+ base n))); increment Block name "_none" (trans (vlax-curve-getStartPoint pl) 0 1) pl att "" "_.insert" blk "_none" "@" "" "" "" ar ); command ); repeat ); progn ); if (*error* nil) ); defun

This is with most of the added requests ; --- writeCSV ---------------------------------------------------------------- ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-a-lisp-for-export-text-to-csv/td-p/9605224 (defun writeCSV ( csvfile dblist dlm / file_w lines text record val) ; function to write .csv file: By Roland.R71 ; Follows csv standards, as far as there are any. ; csvfile = path+filename to use. example: c:\\temp\\mydata.csv ; dblist = a 'database' list of values. (a list of lists) ; dlm = the delimiter to use. example: , ; \t (tab) etc. ; Function checks for delimiter inside values, adds quotes if found. ; ; Example code: ; (setq lst (list '("1" "2" "3") '("4" "5,1" "6") '("7" "8.1" "9") '("" "" ""))) ; (writeCSV "c:/temp/test.csv" lst ",") ; ; example csv file: ; 1,2,3 ; 4,"5,1",6 ; 7,8.1,9 ; ,, (setq file_w (open csvfile "w")) (foreach record dblist (setq i 0 text "") (while (< i (length record)) (setq val (cond ((nth i record))("")) val (cond ((vl-string-search dlm val)(strcat "\"" val "\""))(val)) text (strcat text val) i (1+ i) ) (if (< i (length record)) (setq text (strcat text dlm)) ) ) (write-line text file_w) ) (close file_w) ) ;; EXTRA TODO: ;;;; I made a minor tweaks to match my needs: ;;• for OBJECT TYPES: added POINT ;;• for HYPERLINK: used vlax-get-property hyp 'URLDescription ;;• for INDEX COLOR: show index number ;;• for TRUE COLOR: show RGB format (ie. 0,0,255) ;; http://www.lee-mac.com/colourconversion.html#rgbtru ;; RGB -> True - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->True ( r g b ) (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b)) ) ;; True -> RGB - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)) ) ;; get blockname. ;; you can get the blockname with (assoc 0 ent), except for dynamic blocks. ;; this function also works for dynamic blocks (defun getEffectiveName (ent) (vla-get-effectivename (vlax-ename->vla-object ent)) ) ;; http://www.lee-mac.com/listtostring.html ;; List to String - Lee Mac ;; Concatenates each string in a supplied list, separated by a given delimiter ;; lst - [lst] List of strings to concatenate ;; del - [str] Delimiter string to separate each item (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (defun c:DWH ( / ss i ent obj type handle layer color len area closed hyperlink row rows savepath) (setq ss (ssget (list (cons 0 "*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS")))) (setq i 0) (setq rows (list (list "TYPE" "HANDLE" "LAYER" "HYPERLINK" "COLOR" "AREA" "LENGTH" ))) (repeat (sslength ss) (princ "\n") (setq ent (ssname ss i)) (setq obj (vlax-ename->vla-object ent)) ;; in case we need visual lisp functions ;; These properties exist for every object ;; type of entity (setq type (cdr (assoc 0 (entget ent)))) ;; entity handle (setq handle (cdr (assoc 5 (entget ent)))) ;; layer (setq layer (cdr (assoc 8 (entget ent)))) ;; color ;;• for COLOR: set "By Layer" if nil (setq color "ByLayer") ;; default color. if (assoc 6) or (assoc 420) is found, then we override this (if (assoc 420 (entget ent)) (progn (setq color (cdr (assoc 420 (entget ent)))) ;; true color (princ color) ;; convert to rgb (setq color (LM:True->RGB color)) (setq color (strcat (rtos (nth 0 color) 2 0) "," (rtos (nth 1 color) 2 0) "," (rtos (nth 2 color) 2 0) )) (princ color) ) (if (assoc 62 (entget ent)) (progn (setq color (rtos (cdr (assoc 62 (entget ent))) 2 0) ) ;; indexed color (princ color) ;;(princ (type color)) ;; ) ) ) ;;;; properties for some types. and each has a different way of getting it ;;;; ;; length. ;; blocks don't have a length. ;; regios have a perimeter ;; circles have a circumference ;;(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))) (setq len 0) (cond ( (= type "CIRCLE") (setq len (vla-get-circumference obj)) ) ( (= type "REGION") (setq len (vla-get-perimeter obj)) ) ( (= type "SPLINE") (setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))) ) ( (or (= type "LWPOLYLINE") (= type "POLYLINE")) (setq len (vla-get-Length obj)) ) ) ;; Area. only closed objects have it. Not closed splines/polylines don't. (setq area 0) (cond ( (= type "CIRCLE") (setq area (vla-get-area obj)) ) ( (= type "REGION") (setq area (vla-get-area obj)) ) ( (= type "SPLINE") ;; (assoc 70) is even -> not closed. odd -> closed (if (= 1 (rem (cdr (assoc 70 (entget ent))) 2 )) (setq area (vla-get-area obj)) ) ) ( (or (= type "LWPOLYLINE") (= type "POLYLINE")) (if (= 1 (cdr (assoc 70 (entget ent)))) (setq area (vla-get-area obj)) ) ) ) (setq hyperlink "") ;; Hyperlink ;; https://www.cadtutor.net/forum/topic/41225-read-and-create-an-hyperlink/ (vlax-for hyp (vla-get-hyperlinks obj) (setq hyperlink (vla-get-url hyp)) ) ;; "TYPE" "HANDLE" "LAYER" "HYPERLINK" "COLOR" "AREA" "LENGTH" ;;• for BLOCK: instead of displaying 'INSERT' under type column, display the 'BLOCKNAME' instead (if (= type "INSERT") (setq type (getEffectiveName ent)) ;;(setq type (cdr (assoc 2 (entget ent)))) ) (setq rows (append rows (list (list type handle layer hyperlink color (rtos area 2 4) (rtos len 2 4) ;; CSV export expents strings, not numbers. feel free to change the number of digits (now 4) )))) (princ " *** ") (setq i (+ i 1)) ) ;;(princ rows) ;;(writeCSV csvfile dblist dlm) ;;(setq savepath (strcat (getvar "dwgprefix") (getvar "dwgname") ".csv")) ;;(writeCSV savepath rows ",") ;;(princ savepath) ;;• for FILEPATH: save to Downloads Folder (C:\Users\ \Downloads) ;; Windows user is set in (getvar "loginname") (setq savepath (strcat "C:\\Users\\" (getvar "loginname") "\\Downloads\\" (getvar "dwgname") ".csv")) (princ savepath) (writeCSV savepath rows ",") ;;• for EXCEL: keep the excel file open after saving ;;(setq file (open savepath "w")) (princ ) )

The question of overlapping text I think has been around since CAD was created, some software goes to great lengths to move text around but that can lead to the text is no longer relevant to the point its referencing. The cyan and the magenta text are problems. Not really an answer but I would look at a rotation of text rather than move. Select a few rotate say 30 degrees if ok press Enter else any key to rotate 30 again. Wrapped in a lisp.