Leaderboard

Why explode blocks can make their color grey by resetting block properties. Can use bylayer or byblock. Did this often and changed linetypes etc also.

I think it's because people don't use this method because it's too slow. I edited the gif to save your time. ; CTEXT & PTEXT - 2022.06.30 exceed ; step 1 - use CTEXT, copy all text's handle & textstring to excel (except locked or freezed) ; step 2 - edit in excel C column. ; step 3 - place your cursor in that table, press ctrl+a > ctrl+c ; step 4 - in CAD, press PTEXT to put your new text strings in there (vl-load-com) (defun c:CTEXT ( / *error* ss ssl index textlist obj hand textlayer textlayerobj layerlocked layerfreezed tstring indexr textlista indexc putstring xlcolumns ) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (ex:RELEASEEXCELforctcs) (princ) ) (setq ss (ssget "X" '((0 . "*text")))) (setq ssl (sslength ss)) (setq index 0) (setq textlist '()) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq hand (vlax-get-property obj 'handle)) (setq textlayer (vlax-get-property obj 'layer)) (setq textlayerobj (vlax-ename->vla-object (tblobjname "layer" textlayer))) (setq layerlocked (vlax-get-property textlayerobj 'lock)) (setq layerfreezed (vlax-get-property textlayerobj 'freeze)) (if (and (= layerlocked :vlax-false) (= layerfreezed :vlax-false)) (progn (setq tstring (vlax-get-property obj 'textstring)) (setq textlist (cons (list hand tstring) textlist)) ) (progn ;(princ "\n it's locked or freezed") ) ) (setq index (+ index 1)) ) (ex:ESMAKE) (setq indexr 0) (repeat (length textlist) (setq textlista (nth indexr textlist)) (setq indexc 0) (repeat (length textlista) (setq putstring (nth indexc textlista)) (ex:ECSELPUT (+ indexr 2) (+ indexc 1) (vl-princ-to-string putstring)) (ex:ECSELPUT (+ indexr 2) (+ indexc 2) (vl-princ-to-string putstring)) (setq indexc (+ indexc 1)) );end of repeat rows (setq indexr (+ indexr 1)) );end of repeat columns (ex:ECSELPUT 1 1 "handle") (ex:ECSELPUT 1 2 "old text") (ex:ECSELPUT 1 3 "new text") (ex:ECSELPUT 1 6 "How to Use : Fill new text cell > ctrl+a > ctrl+c > in cad run ptext") (setq xlcolumns (vlax-get-property acsheet 'Columns)) (vlax-invoke-method xlcolumns 'AutoFit) (ex:RELEASEEXCELforctcs) (princ) ) (defun c:PTEXT ( / *error* txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist srllen subindex sclist ss1stacklist ss1count index2 enametoedit newtexttoedit objtoedit ) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq srllen (length selectedrowlist)) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) (setq ss1stacklist (mysort scstack)) (setq ss1count (length ss1stacklist)) (setq index2 3) (repeat (- (/ ss1count 3) 1) (setq enametoedit (handent (cadr (nth index2 ss1stacklist)))) (setq newtexttoedit (cadr (nth (+ index2 2) ss1stacklist))) (setq objtoedit (vlax-ename->vla-object enametoedit)) (vlax-put-property objtoedit 'textstring newtexttoedit) (setq index2 (+ index2 3)) ) (LM:endundo (LM:acdoc)) (princ) ) (defun ex:RELEASEEXCELforctcs ( / ) (if (= AcSheet nil) (progn) (progn (vlax-release-object AcSheet) ;(princ "\n Acsheet Release for next time. Complete.") ) ) (if (= Sheets nil) (progn) (progn (vlax-release-object Sheets) ;(princ "\n Sheets Release for next time. Complete.") ) ) (if (= Workbooks nil) (progn) (progn (vlax-release-object Workbooks) ;(princ "\n Workbooks Release for next time. Complete.") ) ) (if (= ExcelApp nil) (progn) (progn (vlax-release-object ExcelApp) ;(princ "\n ExcelApp Release for next time. Complete.") ) ) ) (defun ex:ECSELPUT ( r c textstring / c addr c1 c2 c3 rng textstring2 ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) (vlax-put-property cell 'item r c textstring2) ) (defun ex:ESMAKE ( / ) ;from BIGAL's ah:chkexcel (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) ) ;; 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) ) ;; 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) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) There are already tons of text editing Lisp. inside of CAD, outside of CAD, or batch modifications. so this is for my handent practice. export all text contents of a drawing to Excel with CTEXT command with handle. and put your edits in the 3rd column then copying the whole table, then input PTEXT in CAD the content is pasted in the same text based on the handle. In the case of overlapping or moving, handles were used instead of coordinates. It doesn't matter if you save the Excel file and use it or delete all unnecessary rows. because it use your clipboard

Also if your blocks have any attributes inside they will lose all data with explode an should probably use burst instead. To simplify the while loop (while (setq AllBlocks (ssget "X" '((0 . "INSERT")(66 . 1))) ;blocks with attributes (command "_.Burst" AllBlocks "") );while (while (setq AllBlocks (ssget "X" '((0 . "INSERT")))) (command "_.Explode" AllBlocks "") );while

and I reckon you can shorten the code a bit like this (defun C:prepbase (/ AllBlocks AllHatches SolOnly sset AllObjects ggrey) ;explode all blocks (setvar "qaflags" 1) ;;;;;;;;;;Do you need this? (setq AllBlocks (ssget "X" (list (cons 0 "INSERT")))) (while (/= AllBlocks nil) (progn (command "_.explode" AllBlocks "") (setq AllBlocks (ssget "X" (list (cons 0 "INSERT")))) );progn );while ;; (if (= AllBlocks nil)(alert "All blocks were exploded")) ;;;;;;;;;;Do you need this like this? (alert "All blocks were exploded") (command "_.erase" "all" "R" (ssget "X" '((0 . "3DSOLID"))) "") (alert "All non-Solid entities deleted. Purge file before exporting to ACIS.") (setvar "qaflags" 0) ;;;;;;;;;;Do you need this? ;delete all hatches (command "_.erase" (ssget "X" (list (cons 0 "HATCH"))) "") (alert "All HATCHES DELETED") ;make everything grey (command "._ChProp" (ssget "X") "" "COLOR" "" "_C" 253 "") (alert "All COLOURS WERE CHANGED") (princ) )

Multi Radio buttons supports vertical or horizontal choice no need to redo code. (ah:butts ahdef "V" (ah:butts ahdef "H"

Try this, you can add more characters like % & etc. (defun c:countext ( / val ss txt pt) (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun (setq tot 0.0) (setq ss (ssget '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq val (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))) (if (= (wcmatch (strcase val) "*A*,*B*,C*,*D*,*E*,*F*,G*,*H*,*I*,*J*,*K*,*L*, *M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil) (princ (setq tot (+ tot (atof val)))) (princ "\nskip") ) ) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) )

Another way. Scratch that this doesn't account for the mid point of the first line. and after looking a the example both lines being selected it looks like they are parallel to each other. (defun c:CSP (/ a b) (if (and (setq a (vlax-ename->vla-object (car (entsel "\nSelect the first line: ")))) (setq b (vlax-ename->vla-object (car (entsel "\nSelect the second line: ")))) );; and (command "_.CIRCLE" "_non" (mapcar '- (vlax-invoke a 'IntersectWith b acExtendNone) '(0 1 0)) pause) );; if (princ) )

WHEN I MADE MY BLOCK IT WOULD RESPOND TO MY SPECIFIED VALUES BUT THEN FOR SOME REASON THAT DYNMODE MUST HAVE CHANGED SOMEHOW AND IT TOOK ME READING THIS POST TO FIND THE SOLUTION. NOT SURE HOW TO MARK THE ANSWER AS A SOLUTION BUT THANKS STEVEN-G

Need to add does string have any characters not in range (chr 48-57), "0-9" then is not pure number. Note if -ve can be a string or a number so would do extra check is 1st character. This is a lambda type thing very fast.