All Activity

Do you have a file? or link to an example file? I have a read function in C++ that should crush performance wise, just want to test it lol

@BHenry85 Give this version a try for nested values. ;; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun c:dext (/ a b blk cells lst myxl row ss x) (vl-load-com) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) ;; RJP » 2024-12-31 - GET NESTED VALUES (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-for blk a (cond ((and (= "AcDbBlockReference" (vla-get-objectname blk)) (= -1 (vlax-get blk 'hasattributes)) (setq a (lm:vl-getattributevalue blk "DETAIL_NUMBER")) (setq b (lm:vl-getattributevalue blk "SHEET_NUMBER")) ) (setq x (strcat "`" a "-" b)) ;get attributes (or (member x lst) (setq lst (cons x lst))) ) ) ) ) (if lst (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) ; opens a new xl ;; RJP - This sorts the list by attribute values (setq lst (vl-sort lst '<)) (setq row 0) (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 itm)) ) (print "NO VALUES FOUND...") ) (princ) ) ;defun

That makes perfect sense. I appreciate the insight. Do you have any way to capture nested versions of the blocks and/or external references that include them?

One of your blocks data has 8-3 .. Excel thinks it's helping by turning it into a date. The only way I know to force the value is to prefix it with `. With the value escaped:

This works as I want it to for the typical block insertions, but I noticed the first line in the excel has some random numbers that are being formatted as a date. Also, is there way to capture similar "DetailBubble" blocks that are within nested blocks in the sample drawing and possibly within external references? Sample Output.xlsx

Here's a version that reports used values with duplicates removed: ; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun c:dext (/ blk cells lst myxl row ss x) (vl-load-com) ;======================================================================================================================================== ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) (if (setq ss (ssget "_X" '((0 . "INSERT")))) (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) ; opens a new xl (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;; RJP - Check the effective name of all blocks (if (= "DetailBubble" (vla-get-effectivename (setq blk (vlax-ename->vla-object ent)))) (progn (setq x (strcat (lm:vl-getattributevalue blk "DETAIL_NUMBER") "-" (lm:vl-getattributevalue blk "SHEET_NUMBER") ) ) ;get attributes (or (member x lst) (setq lst (cons x lst))) ) ) ) ;; RJP - This sorts the list by attribute values (setq lst (vl-sort lst '<)) (setq row 0) (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 itm)) ) ) (princ) ) ;defun

This is because these are dynamic blocks that have been modified which creates an anonymous block name ( *U# ) and the ssget filter is looking for "DetailBubble". Give this a try ... it tallies your detail blocks that have duplicate values. I did not read this whole thread so hopefully that is what you're trying to do ; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun c:dext (/ blk cells lst myxl row ss x) (vl-load-com) ;======================================================================================================================================== ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) (if (setq ss (ssget "_X" '((0 . "INSERT")))) ;get detail blocks (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) ; opens a new xl (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;; RJP - Check the effective name of all blocks (if (= "DetailBubble" (vla-get-effectivename (setq blk (vlax-ename->vla-object ent)))) (progn (setq x (strcat (lm:vl-getattributevalue blk "DETAIL_NUMBER") "-" (lm:vl-getattributevalue blk "SHEET_NUMBER") ) ) ;get attributes ;; RJP - are you trying to tally duplicates? (if (assoc x lst) (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst)) ;get list of values (setq lst (cons (cons x 1) lst)) ;create list ) ) ) ) ;; RJP - This sorts the list by attribute values (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))) (setq row 1) (xlsetcelltext row 1 "ATTRIBUTES") (xlsetcelltext row 2 "TOTAL DUPLICATES") (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 (car itm)) (xlsetcelltext row 2 (cdr itm)) ) ) ) (princ) ) ;defun This is the result for your 'Large Reference' drawing: ATTRIBUTES TOTAL DUPLICATES ADF-2004 4 AEX-NE01 24 BRK-0101 6 BRK-0104 2 BRK-0108 15 BRK-0115 2 BRK-0201 3 BRK-0411 25 BRK-0418 18 BRK-0426 4 BRK-0427 4 BRK-0610 6 BRK-0612 3 BRK-0702 6 BRK-0705 6 BRK-0710 6 BRK-0801 6 BRK-0810 6 BRK-0815 6 BRK-0832 14 CMS-0101 14 CMS-0201 9 CMS-0202 30 CMS-0411 3 CMS-0420 3 CMS-0617 11 CMS-0618 3 CMS-0701 20 CMS-0702 20 CMS-0703 20 CMS-0721 3 CMS-0722 3 CMS-0723 3 CMS-0815 6 CMS-0820 6 DPL-0201 3 DPL-0202 6 DRT-0110 9 MSV-0101 1 MSV-0102 2 MSV-0104 3 MSV-0202 3 MSV-0421 5 MSV-0602 3 MSV-0701 3 MSV-0704 6 MSV-0705 3 MSV-0801 3 MSV-0802 3 MSV-0805 2 RFM-0202 1 RFM-0220 3 RFM-0224 9 RFM-0225 3 RFM-0226 3 RFM-0601 9 SFD-0113 12 SFD-0114 2 SFD-0154 2 SFD-2101 1 SFF-0102 16 SFF-0103 8 SFF-0107 8 SFF-0109 26 SFF-0112 56 SFF-0123 2 SFL-0150 6 SFL-0153 13 SFL-0160 13 SFR-0112 9 SNB-0101 7 SNB-0103 5 SNB-0108 18 SNB-0109 7 SNB-0111 6 SNB-0112 8 SNB-0113 8 SNB-0119 5 SNC-2101 18 SNC-2104 12 SNC-2105 6 SNC-2106 3 SNC-2107 9 SNC-2117 3 SNC-2119 3 SNC-2120 9 SNS-2100 24 SNS-2200 26 SNS-2201 15 SNS-2203 6 SNS-2204 12 SNS-2206 4 SNS-2207 5 SNS-2209 9 SNS-2210 18 SNS-2212 9 SNS-2213 1 TRM-0610 9

Yes, the command should just list only the details that are inserted into the drawing, remove any duplicates, and then spit those out into an alphabetized list. The version you provided does open a new instance of excel and exports the list of some details, which is neat, but it still isn't the full list of details that are in the drawing.

Just finished the project with the help of ReMark. He was EXTREMELY patient and helpful with the project. If one of the Penn Foster teachers tells you something is incorrect that ReMark has told you, double check with another teacher. I had a situation where he helped me with a Cul-de-sac and he was correct, while one of the other teachers were incorrect. I HIGHLY recommend reaching out to him with any questions or concerns you may have.

@ronjonp Thank you very much, now the code works perfectly! Creative success in the new year!

Try the code above again .. I missed setting the 'ff' variable.

Yes: I think the only way to achieve this is by transforming each byte into a list of bits. I have already done this. Now I am finishing designing the read and write functions to work with single (32 bits) and double (64 bits) precision numbers. Once I finish this work and test it, I will leave the result in this thread, in case anyone finds it useful. In any case, one thing is clear: in Lisp it cannot be so efficient.

For some reason, this code doesn't work. ; error: ActiveX Server returned an error: The parameter is required

Thanks, Bigal and Steven, that helps me to get it to work

@BIGAL Thank you for your suggestion and Multi radio buttons.lsp. I'll try this method...

@ronjonp thank you for correcting the errors and especially for the comments... My knowledge of lisp programming is very limited...

Hi, can I get the TTT lisp? for rearrange overlap text

Interesting, there’s no bit type, you will have to read bytes and unpack the bits. Curious how this would be done efficiently in lisp easier in C++, depending on endianness just memcpy or a cast

Using object snap is your friend as previously mentioned, I have shortcuts set up so can switch snaps which helps with tasks like only select ends. Not sure if your aware but can call a snap not set just hold down the shift key and press right button on mouse. The other if drawing square use F8 key ortho on and off. Another hint to draw a line of a length say with ortho on. pick start point drag mouse for direction then type distance line done ! I use this osnap setting most times, you just type OSMODE then 47. Its end, mid, cen, node, intersection. If you have osnaps that you like just set them then type Osmode a number will appear, you can reset your osnaps any time using osmode and that number. The other handy one is in a command type M2P this is get the midpoint of two picked points very useful. I am sure others will provide some more hints.

I don't use initget anymore rather this. (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (setq ans (ah:butts but "V" '("Please Choose" "All" "All in tab" "Select objects")))) ; ans holds the button picked as an integer value (cond ((if (= ans "All")(setq ss (ssget "_X" '((0 . "*TEXT")))))) ((if (= ans "All in tab")(setq ss (ssget "_X" '((0 . "*TEXT")(cons 410 (getvar 'ctab))))))) ((if (= ans "Select objects")(setq ss (ssget "_:L" '((0 . "*TEXT")))))) ) If you don't want to use the "ans" value you can use the variable but, it is a number matching the button selected, so All would return but=1. Multi radio buttons.lsp

As someone else noted, there are multiple options for any process in AutoCAD. Find one that works for you and keep moving forward. You can always come back later and experiment with the other options. You may even find something that works better. To align objects, such as the endpoints of lines, there's always object snaps. Do a little research, find out how they work, and you'll save a lot of time. Every transformation command has options to move/rotate/scale to fit one object to another. Another thing to start on immediately is Properties. Open the Properties window and keep it open. Learn what the values are and what they mean. Once you understand properties, you'll be a long way down the road to mastering AutoCAD.

@Nikon There were a few errors in the code you posted .. FWIW here are some modifications with comments. ;; Create a new text style and replace all styles in the drawing (defun c:cr-txtst-sel2 ;; RJP - Localize all variables (/ acaddoc eo ff i objstyle oldcmd select ss styles) (vl-load-com) ;; RJP - Check that the font can be found otherwise BOOM! Also search for the system font not tied to a CAD version (if (findfile (setq ff (strcat (getenv "WINDIR") "\\FONTS\\ARIALN.ttf"))) ;; (findfile (setq ff "C:\\Program Files\\Autodesk\\AutoCAD 2019\\Fonts\\ARIALN.ttf")) (progn (setq acaddoc (vla-get-activedocument (vlax-get-acad-object))) (setq styles (vla-get-textstyles acaddoc)) ;; Add the style named "ArialN0" (setq objstyle (vla-add styles "ArialN0")) ;; Assign fontfile "ARIALN.ttf" to the style (vla-put-fontfile objstyle ff) ;; Optional: Make the new style Active (vla-put-activetextstyle acaddoc objstyle) ;; Replace All/Select texts with the ArialN0 style (initget "All Select") (if (= "All" (setq select (getkword "\nSelect text to change [All/Select] <Select> : "))) (setq ss (ssget "_X" '((0 . "*TEXT")))) (setq ss (ssget "_:L" '((0 . "*TEXT")))) ) ;; RJP - Check for valid selection (if ss (progn (setq oldcmd (getvar "cmdecho")) (setvar "cmdecho" 0) (repeat (setq i (sslength ss)) (setq eo (vlax-ename->vla-object (ssname ss (setq i (1- i))))) ;; RJP - Check that the text can be modified (if (vlax-write-enabled-p eo) (vlax-put eo 'stylename "ArialN0") ) ) ;; RJP - This line below bombs the code? ;; (vla-endundomark doc) ; Set the style to the current one (vl-cmdf "_-PURGE" "_ST" " " "_N") ; clear unused text styles (setvar "cmdecho" oldcmd) ) ) ) (alert (strcat ff " NOT FOUND!")) ) (princ) )

Hi, I have an existing palette with multiple blocks and the existing source drawing with these blocks. I want to edit these existing blocks, more specifically I want to update some of the attributes on these blocks and then place these updated versions on a new palette. I can open a block and edit the properties, or I can go into block editor and update the attributes there, but once I place this block on the new palette and open in a new drawing, all the details have reverted back to the original block set up. Can anyone help shed some light on what I'm doing wrong or how I should accomplish this? Thanks

Here's another, not quite as advanced as CAB's BreakAll program, but I had fun writing it - (defun c:breakwith ( / *error* brk brl ent ftr idx sel ) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (setq ftr (list '(0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE") '(-4 . "<NOT") '(-4 . "<AND") '(0 . "POLYLINE") '(-4 . "&") '(70 . 80) '(-4 . "AND>") '(-4 . "NOT>") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")) ) ) (LM:startundo (LM:acdoc)) (cond ( (not (setq sel (LM:ssget "\nSelect objects to break: " (list "_:L" ftr))))) ( (not (setq brk (LM:ssget "\nSelect breaking edges: " (list ftr))))) ( (progn (repeat (setq idx (sslength brk)) (setq idx (1- idx) ent (ssname brk idx) ) (if (not (ssmemb ent sel)) (setq brl (cons (vlax-ename->vla-object ent) brl)) ) ) (null brl) ) (princ "\nAll selected breaking edges were also selected to be broken.") ) ( (repeat (setq idx (sslength sel)) (setq idx (1- idx)) (breakwithlist (ssname sel idx) brl 1) ) ) ) (*error* nil) (princ) ) (defun breakwithlist ( ent lst mxd / cmd enl obj pnt pt1 pt2 tmp ) (cond ( (< 256 mxd)) ;; Just in case ( (setq obj (vlax-ename->vla-object ent) pt1 (vlax-curve-getstartpoint ent) pt2 (vlax-curve-getendpoint ent) pnt (vl-some '(lambda ( x ) (vl-some '(lambda ( p ) (if (and (not (equal p pt1 1e-8)) (not (equal p pt2 1e-8)) ) p ) ) ( (lambda ( l / r ) (repeat (/ (length l) 3) (setq r (cons (mapcar '(lambda ( a b ) a) l '(0 1 2)) r) l (cdddr l) ) ) (reverse r) ) (vlax-invoke obj 'intersectwith x acextendnone) ) ) ) lst ) ) (setq enl (entlast) cmd (getvar 'cmdecho) pnt (trans pnt 0 1) ) (while (setq tmp (entnext enl)) (setq enl tmp) ) (setvar 'cmdecho 0) (vl-cmdf "_.break" (list ent pnt) "_f" "_non" pnt "_non" pnt) (setvar 'cmdecho cmd) (if (entnext enl) (breakwithlist ent lst (1+ mxd)) ) (while (setq enl (entnext enl)) (breakwithlist enl lst (1+ mxd)) ) ) ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) (vl-load-com) (princ)