Jump to content

Recommended Posts

Posted (edited)

ezgif.com-gif-maker%20(24).gif

 

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

 

 

 

Edited by exceed
  • Like 4
  • Thanks 1
Posted

Hello @exceed

Lisp error 

Command: CTEXT
 Error: no function definition: EX:ESMAK

thanks

  • Like 1
Posted

Thanks

I love your lisp so much. I do not have a lot of knowledge about autolisp programming.Can you tutoriate me or control your lisp more completely?

  • Like 1
Posted

Hi exceed,

nice lisp.

 

When I write ptext 

AutoCad Error: no function definition: LM:STR->LST

 

What´s wrong?

thanks

  • Like 1
Posted (edited)
51 minutes ago, Juergen said:

Hi exceed,

nice lisp.

 

When I write ptext 

AutoCad Error: no function definition: LM:STR->LST

 

What´s wrong?

thanks

 

i edited original code.

i forgot to paste LM:str->lst

http://www.lee-mac.com/stringtolist.html

 

 

snippets of Lee mac were loaded in my CAD by default, so I did not find any problems.

 

His site has a lot of helpful lisp things, so I recommend reading it.

Edited by exceed
Posted

Thanks for the info!

 

It work perfect!!

  • Like 1
Posted

Hi exceed,

there is one more note.

 

Excel changes the value if E is in the reference.
e.g. Reference = 759e2 becomes 7.59E+04.
Is it possible that an apostrophe is written before the reference number? (handle: '759e2)

So Excel does not convert to scientific. (exponential)

 

Thanks.

  • Like 1
Posted (edited)

I think the way my boss's lisp gets around this is that it formats the cell as text instead of general

 

--edit

This also helps with leading 0's

Edited by mhupp
  • Like 1
Posted (edited)
2 hours ago, Juergen said:

Hi exceed,

there is one more note.

 

Excel changes the value if E is in the reference.
e.g. Reference = 759e2 becomes 7.59E+04.
Is it possible that an apostrophe is written before the reference number? (handle: '759e2)

So Excel does not convert to scientific. (exponential)

 

Thanks.

1 hour ago, mhupp said:

I think the way my boss's lisp gets around this is that it formats the cell as text instead of general

 

--edit

This also helps with leading 0's

 

@Juergen thanks for the note. I updated it to this code

@mhupp that's good idea, but i think, if we modify the cell with the text attribute, there is likely to be a problem when using formulas such as vlookup like above gif. in this case we need one more process or evaluate..

if we add ' in front of a cell, we can get a text-like property,

and we can use a formula right away, and we can also calculate when it is a number.

 

but someone may like it that way, so i attached version 2 in here without modification of the original😀

 

; CTEXT & PTEXT ver.2 - 2022.07.11 exceed
; step 0 - In Excel's options, you need to set to allow 'vba macros' so that autolisp can control Excel.
; 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
;
; updates 
; - address calculation of ex:ECSELPUT snippet was modified by Gilles Chanteau's awsome calculation method. The code is more concise.
; - for support the expression of exponents or starting with 0,
;   ' is added in front of the input in Excel. This is excluded when doing PTEXT.


(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 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) (strcat "'" (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)

  ;(princ ss1stacklist)
  
  (repeat (- (/ ss1count 3) 1)
    (setq enametoedit (handent (cadr (nth index2 ss1stacklist))))
    (setq newtexttoedit (substr (vl-princ-to-string (cadr (nth (+ index2 2) ss1stacklist))) 1))
    (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 / tc addr rng textstring2 )
 (setq tc (Number2Alpha c))
 (setq addr (strcat tc (itoa r) ":" tc (itoa r)))
 (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)
    )
)

;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    )
  )
);defun Number2Alpha

 

 

for more upgrade, it will be faster to make a list and paste it at once instead of entering the cell one-by-one in the CTEXT process.
I'm also working on weekends because my busy work that made this happen is still going on.🥲

Edited by exceed
  • Like 1
Posted (edited)

Have a button in excel to call/run commands in BricsCAD so you don't have to alt+tab all the time.

 

VBA Code

Sub PTEXT()
    On Error Resume Next
    Dim app As Object, Doc As Object
    On Error Resume Next
    Set app = GetObject(, "BricscadApp.AcadApplication") 'Checks if BricsCAD is open probably have to change for AutoCAD.
      If app Is Nothing Then
        MsgBox "BriscCAD isns't Open!", vbCritical, "Output Error"
        Exit Sub
      End If
    Set Doc = app.ActiveDocument
    Doc.SendCommand "PTEXT" & vbCr 'Lisp Command
End Sub

 

Edited by mhupp
vba use ' not ; to comment
  • Like 1
Posted

I use Bricscad and Acad so maybe do the set check twice.

 

Sub PTEXT()
    On Error Resume Next
    Dim app As Object, Doc As Object
    On Error Resume Next
    
    Set app = GetObject(, "BricscadApp.AcadApplication") 'Checks if BricsCAD is open probably have to change for AutoCAD.
      If app Is Nothing Then 'Checks if Autocad is open
    Set App = GetObject(, "AutoCAD.Application")
      End If
      If app Is Nothing Then
        MsgBox "BriscCAD / Autocad isns't Open!", vbCritical, "Output Error"
        Else: MsgBox "Cad found"
        Exit Sub
      End If
End Sub

app twice 

  • Like 1
  • 3 weeks later...
Posted (edited)

Chào

@ BIGAL, mhupp

help me to edit the above lisp. thanks!

Edited by taybac214
Posted

When I create automatic layouts with drawing :LONG1.LISP works fine. But when I change VIEWPORT position with drawing :Long2 to match my commonly used name frame, lisp doesn't work properly. Please help me adjust the lisp so that with drawing:Long2 works.thanks

z3600394256874_7e0b1debbccc476916217c3f971a25fa (1).jpg

GridsToLayouts.lsp LONG1.dwg LONG2.dwg

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...