Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/05/2022 in all areas

  1. 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
    1 point
  2. Since the string to be found is already being passed an argument to your function, you can 'hardcode' it by simply defining another function which evaluates your function with a hardcoded string, e.g.: (defun c:test ( ) (chkmtxtstr "MyTextString") ) Though, if you're happy with a case-sensitive match and assuming the MText content has no formatting and does not straddle multiple DXF group 3 entries, the code can become much simpler - consider the following: (defun find ( str ) (ssget "_X" (list '(0 . "MTEXT") (cons 1 (strcat "*" str "*")))) ) Since the above will return a selection set, you can call it in the following way: (defun c:test ( / sel ) (if (setq sel (find "YourString")) (command "_.change" sel "" "_p" "_la" "0" "_c" "ByLayer" "") ) (princ) )
    1 point
  3. Sometimes with this type of thing insert the block and as a second step up date it, so you would use (entlast) to get object then put dynamic properties. I know that for blocks must get the id every time as it must reflect the inserted block. You can not copy the block if you have set a ID. Why dynamic block does it do something special ? Where are the values coming from? You may need to post a real dwg.
    1 point
  4. My $0.05 (while (setq ss (ssget "_+.:E:S" '((0 . "*text")))) I will let you work out where the closing ) should go. Move (c:foo) to last line it will run then on load and any time want more just type FOO
    1 point
  5. (vl-load-com) (defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (if (= (wcmatch (strcase (vl-princ-to-string 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) (progn (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) );end of cond );end of progn (progn (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) );end of progn );end of if );end of repeat (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) );end of while (princ "\n finished, result is = ") (princ tot) (princ "\n in expression = ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (if (= (wcmatch (strcase (vl-princ-to-string 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) (progn (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) );end of cond );end of progn (progn (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) );end of progn );end of if );end of repeat (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (princ "\n in expression ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (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 ;; Parse Numbers - Lee Mac ;; Parses a list of numerical values from a supplied string. (defun LM:parsenumbers ( str ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) (cons nil l) l (append (cdr l) '(())) ) ) ")" ) ) ) (vl-string->list str) ) ) in that case, you can use BIGAL's above code like this the code is dirty because I was less awake and wrote the if and repeat in reverse and modified other parts, but it will work as expected.haha
    1 point
  6. And this version put the text in the middle of the polyline and makes the width the same as the counter. (defun c:numberpolylines ( / txthght sspolylines acount ssent txtpt ) (vl-load-com) ;;https://autocadtips1.com/2011/10/21/autolisp-mid-point-of-entire-polyline/ (defun MidPoly ( ename / entl en oname param hLen MidPt ) (setq entl (entget ename) en (cdr (assoc 0 entl)) ) ;end setq (setq oname (vlax-ename->vla-object ename) param (vlax-curve-getEndParam oname) hlen (* (vlax-curve-getDistAtParam oname param) 0.5) MidPt (vlax-curve-getPointAtDist oname hLen) ) ;end setq (vlax-release-object oname) MidPt ) ;end defun (defun createtext ( MyText TextPoint textheight / ) ;; a sub routine to create text. (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbText") (cons 10 TextPoint) (cons 40 textheight) (cons 1 MyText) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) ;; (cons 7 font) '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0) ));end list, entmake ) ;;end sub routine (setq txthght 2.5) ;; text height - can calculate this later if needed to make it relative to polyline lengths and so on (setq sspolylines (ssget '((0 . "LWPOLYLINE")) )) ;get selection set, filter it to only LWPolyline types (setq acount 0) ;;just a counter (while (< acount (sslength sspolylines)) ;; do a loop for the length of the selection set (sslength) (setq ssent (ssname sspolylines acount )) ;;get the nth entity details in the selection set (setq TxtPt (MidPoly ssent)) ;;calls MidPoly routine and gets the point result as TxtPt (setq txtpt (mapcar '+ (list 0 (/ (+ acount txthght) 2) 0) txtpt )) ;; offset txtpt for text position by x:0, y: half text height + line width, z:0 (setq acount (+ acount 1)) ;;increase count by 1. Increased here to make the displayed text start at 1 (command "pedit" ssent "w" acount "") ;;adjusts line width to the count (createtext (rtos acount) txtpt txthght) ;; run subroutine to create text ) (princ) ;; exit silently ) So over to you now, how you want to use this or amend to suit what you want
    1 point
  7. Using entsel or ssget :E:S is more standard in this case. you are correct it's just my habit. haha I often use ssget to select a window even if when I select only one. because that's personally less likely to make a mistake. (cancel when I select another place, or to not be able to exclude it with shift is more uncomfortable for me)
    1 point
  8. Its my pleasure Romero and you are welcome anytime.
    1 point
×
×
  • Create New...