Leaderboard

I was thinking something like this to modify the block definition ( assuming we're dealing with rectangles ). (defun c:foo (/ d f l ll p tx ur) ;; RJP » 2022-01-21 Adds text of blockname to block definition (setq l "BlockNameText") (vla-add (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) l) (vlax-for b (vla-get-blocks d) (cond ((= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (setq f nil) (vlax-for o b (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur))) (princ (strcat "\nBad JuJu in block: " (vla-get-name b))) (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur))) ) (or f (setq f (= l (vla-get-layer o)))) ) (cond ((and (null f) ll ur (setq tx (vla-addtext b (vla-get-name b) (vlax-3d-point (setq p (append (mapcar '/ (mapcar '+ ll ur) '(2 2)) (list (max (last ll) (last ur))) ) ) ) 0.05 ) ) ) (vla-put-alignment tx 10) (vlax-put tx 'textalignmentpoint p) ;; (vla-put-height tx (/ (abs (apply '- (mapcar 'cadr (list ll ur)))) 4)) (vla-put-layer tx l) ) ) ) ) ) (vla-regen d acallviewports) (princ) )

1st up AT:listselect was written by Alan J Thompson. That acknowledgement should be in code. replace the defun (defun C:BlkInsert (/ pt SS ent lst blkname) (vl-load-com) (setq lst (list "blkname1" "blkname2" "blkname3" "blkname4")) (while (setq pt (getpoint "\nPick Point")) (setq blkname (AT:ListSelect "Block(s) in Drawing" "Pick A Block" 30 60 "false" lst)) (vl-cmdf "_.Insert" (car blkname) "_non" pt 0.0254 0.0254 0) ) (princ) ) Also can use dcl's and images

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/spacing-blocks-evenly/m-p/6988087/highlight/true#M351761

I think "each item in the list has an entity name and a pick point" means something like this: the list = item1 = {entity1 pickpoint1} item2 = {entity2 pickpoint2} item3 = {entity3 pickpoint3} ... and so on. (It can be different, check the data yourself) therefore: (foreach item list ...) will get you iterate through the items, each item = (entity pickpoint) from that item, to get the entity: (setq entity (car item)) to get the pickpoint (setq pickpoint (cadr item)) Now you want to run copy command, run it over that entity, not that item. Your (1) structure is a better one, but should be like: (foreach item list (setq entity (car item) ;change these accordingly to your item data structure pickpoint (cadr item) ;maybe this one is the base point to copy? not a fixed basept from somewhere else? ) (command "copy" entity "" basept despt) )

Hello Allan B. and welcome to CadTutor. Sorry I am not a member of The Lisperatti, and so am unable to help you with this. Your first post is very well defined, unambiguous, and I am quite sure that there is no shortage of forum members better suited to the task, who will get you back on the tracks. Should you be unfamiliar with, although I doubt it, LeeMac just might have something on his excellent site to help you help yourself. When in doubt, check LEEMAC out! Thanks Lee!

Look at Bricscad much cheaper than Autocad for home use and its up to date, or one of the other clones, just make sure support for lisp etc.

The home user version of Longbow Converter is currently priced at $79.99 US. That would be my recommendation.

A few sites I trust besides Cadtutor: http://www.lee-mac.com/programs.html https://www.afralisp.net/ https://jtbworld.com/autolisp-visual-lisp https://autolisp-exchange.com/ https://gilecad.azurewebsites.net/Lisp.aspx Got to be responsible though put them in a folder in both the Support File Search Path and Trusted Folders. I also don't download any compiled code, lisp and dcl only.

Maybe this, not tested save list as ((y X)(y x).... ; sorts on 1st two items (vl-sort lst '(lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))) ) ) )

(vl-load-com) (defun c:TEXTEXPORT( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) (setq x (1+ x)) ) (setq y (1+ y) x 1) )(princ) ) (defun c:TEXTEXPORTINCOLUMN( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) ;(setq x (1+ x)) ;edited line (setq y (1+ y) x 1) ;edited line ) ;(setq y (1+ y) x 1) ;edited line )(princ) ) (defun c:TEXTEXPORTINROW( / objs doc tol excel cell str x y PTE:sortobj LM:UnFormat) ; Sub-function - 01 (defun PTE:sortobj ( olst typ tol / typ objs opt npt lst data lst rev sx sy dxf x y PTE:s1 PTE:s2 PTE:s3 PTE:s4 ) (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls)) (defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b))))) (defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b))))) (defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o))))) (defun x (o) (car (dxf o 10))) (defun y (o) (cadr (dxf o 10))) (setq typ (vl-string->list (strcase typ))) (if (member (car typ) '(76 82)) (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev) (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev) ) (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs))) (foreach o objs (if (< tol (abs (- (setq npt (PTE:s2 o)) opt))) (setq lst (cons data lst) data (list o) opt npt) (setq data (cons o data)) ) ) (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst)) lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst) ) ) ; Sub-function - 02 (defun LM:UnFormat ( str mtx / _Replace regex ) ;; ⓒ Lee Mac 2010 (defun _Replace ( new old str ) (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new) ) (setq regex (vlax-get-or-create-object "VBScript.RegExp")) (mapcar (function (lambda ( x ) (vlax-put-property regex (car x) (cdr x))) ) (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) ) (mapcar (function (lambda ( x ) (setq str (_Replace (car x) (cdr x) str))) ) '( ("Ð" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) ) (setq str (if mtx (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_Replace "\\" "Ð" str) ) ) (vlax-release-object regex) str ) ;================================================================================== ; Main function ;================================================================================== (ssget '((0 . "text,mtext"))) (setq doc (vla-get-activedocument (vlax-get-acad-object)) objs (vlax-for o (vla-get-activeselectionset doc) (setq objs (cons o objs))) tol (car (vl-sort (mapcar 'vla-get-height objs) '<)) objs (PTE:sortobj objs "rdr" tol) ) (or (setq excel(vlax-get-or-create-object "Excel.Application")) (alert "Fail to Excel load") (exit) ) (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Add) (vlax-put Excel 'visible :vlax-true) (setq cell (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells) x 1 y 1 ) (foreach os objs (foreach o os (setq str (if (= (vla-get-objectname o) "AcDbText") (vla-get-textstring o) (LM:UnFormat (vla-get-textstring o) nil) ) ) (vlax-put-property cell 'item y x (strcat "'" str)) (setq x (1+ x)) ) ;(setq y (1+ y) x 1) ;edited line )(princ) ) maybe you want like this command TEXTEXPORTINCOLUMN I'm not original author of this code add 2 options by just edit last 3 lines. TEXTEXPORT : original lisp. justify rows and columns by it's location. TEXTEXPORTINCOLUMN : 1 column export TEXTEXPORTINROW : 1 row export

(defun c:ttx2 (/ ss xlApp xlCells row col i) (vl-load-com) (if (setq ss (ssget '((0 . "*TEXT")))) (progn (setq xlApp (vlax-get-or-create-object "Excel.Application") xlCells (vlax-get-property (vlax-get-property (vlax-get-property (vlax-invoke-method (vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells") row 0 col 1) (vla-put-visible xlApp :vlax-true) (foreach y (mapcar '(lambda (x / iPt) (setq iPt (vlax-get x 'InsertionPoint)) (list (LM:UnFormat (vla-get-TextString x) nil) (rtos (car iPt) 2 2) (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))) (if (> row 65536) (setq col 5)) (setq i -1 row (1+ row)) (mapcar (function (lambda (x) (vlax-put-property xlCells "Item" row (+ col (setq i (1+ i))) x))) y)))) (mapcar 'vlax-release-object (list xlApp xlCells)) (princ)) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (vl-load-com) This routine can export text and x, y, z coordinates to excel I get this at https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autocad-how-get-text-to-excel-use-visual-lisp/td-p/9539871 then I add LM:unformat for mtexts. http://www.lee-mac.com/unformatstring.html then add first row for filter, then sort ascending C column (y axis, up to down) first, B column (x axis, left to right) second in excel. https://support.microsoft.com/en-us/office/sort-data-in-a-table-77b781bf-5074-41b0-897a-dc37d4515f27

HI SEE THIS IS

Jet Black workspace, just like the universe.