+ Reply to Thread
Page 1 of 4 1 2 3 ... LastLast
Results 1 to 10 of 32
  1. #1
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    625

    Default Lisp to deal with text/Mtext

    Registered forum members do not see this ad.

    Is there a lisp do this job
    To select the text (and Mtext too) and but each string in a single line and but next to it the count of that string

    For example

    I have this text in a drawing
    T12-100
    T10-100
    T16-100
    T12-150

    And the same values repeated (in the same file)
    The lisp collects the text string and count how many time repeated each text/Mtext

    Text Repetition
    T12-100 5
    T10-100 6
    T16-100 16
    T12-150 7

    And so on

    Hasan
    Sorry for my English.

  2. #2
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Try this:

    Code:
    (defun c:tsel (/ ss lst tss olst ofile)
      (vl-load-com)
      (if (setq ss (ssget '((0 . "*TEXT"))))
        (progn
          (setq lst
            (mapcar
              (function
                (lambda (x)
                  (vla-get-TextString
                    (vlax-ename->vla-object x))))
              (vl-remove-if 'listp
                (mapcar 'cadr (ssnamex ss)))))
          (foreach str (unique lst)
            (if (setq tss
                  (ssget "_X"
                    (list '(0 . "*TEXT") (cons 1 str))))
              (setq olst
                (cons
                  (cons str (sslength tss)) olst))
              (setq olst
                (cons
                  (cons str 0.) olst))))
          (setq ofile
            (open
              (strcat
                (getvar "DWGPREFIX")
                  (substr
                    (getvar "DWGNAME") 1
                      (- (strlen
                           (getvar "DWGNAME")) 4)) "-StrCnt.txt") "a"))
          (mapcar
            (function
              (lambda (x)
                (write-line
                  (strcat (car x) "\t"
                    (vl-princ-to-string (cdr x))) ofile))) olst)
          (close ofile)
          (princ "\n<< Strings Written to File >>"))
        (princ "\n<< Nothing Selected >>"))
      (princ))
    
    ;; CAB
    (defun unique (lst / result)
      (reverse
        (while (setq itm (car lst))
          (setq lst (vl-remove itm lst)
                result (cons itm result)))))
    Will write the result to file.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  3. #3
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    625

    Default

    whats great

    Could be the result in a table in the same file


    Regards
    Sorry for my English.

  4. #4
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Quote Originally Posted by asos2000 View Post
    whats great

    Could be the result in a table in the same file


    Regards
    Wasn't sure if '06 had tables, but yes, this could be done;
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  5. #5
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Ok try this:

    Code:
    (defun c:tsel (/ *error* doc spc ss bPt
                     lst tss olst tblObj i)
      (vl-load-com)
    
      (defun *error* (msg)
        (and doc (vla-EndUndoMark doc))
        (if
          (not
            (wcmatch
              (strcase msg)
                "*BREAK,*CANCEL*,*EXIT*"))
          (princ
            (strcat
              "\n<< Error: " msg " >>")))
        (princ))
          
      (setq doc
        (vla-get-ActiveDocument
          (vlax-get-Acad-Object))
            spc (if
                  (zerop
                    (vla-get-activespace doc))
                  (if (= (vla-get-mspace doc) :vlax-true)
                    (vla-get-modelspace doc)
                    (vla-get-paperspace doc))
                  (vla-get-modelspace doc)) i 2)
      (cond ((eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
             (princ "\n<< Current Layer Locked >>"))
            (t
              (if (and (setq ss (ssget '((0 . "*TEXT"))))
                       (setq bPt (getpoint "\nSelect Point for Table: ")))
                (progn
                  (vla-StartUndoMark doc)
                  (setq lst
                    (mapcar
                      (function
                        (lambda (x)
                          (vla-get-TextString
                            (vlax-ename->vla-object x))))
                      (vl-remove-if 'listp
                        (mapcar 'cadr (ssnamex ss)))))
                  (foreach str (unique lst)
                    (if (setq tss
                          (ssget "_X"
                            (list '(0 . "*TEXT") (cons 1 str))))
                      (setq olst
                        (cons
                          (cons str (sslength tss)) olst))
                      (setq olst
                        (cons
                          (cons str 0.) olst))))
                  (setq tblObj
                    (vla-addTable spc
                      (vlax-3D-point bPt)
                        (+ 2 (length olst)) 2 (* 1.5 (getvar "DIMTXT"))
                          (* (apply 'max
                               (mapcar 'strlen
                                 (append '("String")
                                   (apply 'append
                                     (mapcar
                                       (function
                                         (lambda (x)
                                           (list (car x)
                                             (rtos (cdr x) 2 0)))) olst)))))
                             1.5 (getvar "DIMTXT"))))
                  (vla-setText tblObj 0 0 "String Counter")
                    (vla-setText tblObj 1 0 "String")              
                      (vla-setText tblObj 1 1 "Count")
                  (foreach x (vl-sort olst
                               (function
                                 (lambda (a b)
                                   (< (car a) (car b)))))
                    (vla-setText tblObj i 0 (car x))
                      (vla-setText tblObj i 1 (rtos (cdr x) 2 0))
                        (setq i (1+ i)))
                  (vla-EndUndoMark doc)))))
      (princ))
                  
    
    ;; CAB
    (defun unique (lst / result)
      (reverse
        (while (setq itm (car lst))
          (setq lst (vl-remove itm lst)
                result (cons itm result)))))
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  6. #6
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    625

    Default

    WOW, that what im looking for.
    Thanks LEE

    But there are 2 points
    - Could the lisp use the default text style (not standard)?
    - STRING & COUNT words in the table come in 2 lines when the text string is one or tow digits.

    mmmm, while typing there are 2 more things came in my mind
    - Could I choose the table style (there are stored table styles in the file)?
    - Could the lisp collect the text/attribute in the blocks?
    Sorry for my English.

  7. #7
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Quote Originally Posted by asos2000 View Post
    But there are 2 points
    - Could the lisp use the default text style (not standard)?
    - STRING & COUNT words in the table come in 2 lines when the text string is one or tow digits.

    mmmm, while typing there are 2 more things came in my mind
    - Could I choose the table style (there are stored table styles in the file)?
    - Could the lisp collect the text/attribute in the blocks?
    The LISP uses the default TableStyle - so just set the table style how you want it.

    As for the STRING and COUNT coming in as 2 lines, I thought I had accounted for this, but I can increase the column width if necessary.

    As for the blocks - will you still be selecting them?
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  8. #8
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    625

    Default

    As for the blocks, No need for still be selecting them.

    I creat that macro but not working
    -table;;;style;EC-TABLE-100;;stringcounter;
    EC-TABLE-100 is a tablestyle
    Sorry for my English.

  9. #9
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Quote Originally Posted by asos2000 View Post
    - Could the lisp collect the text/attribute in the blocks?
    I can maybe collect attributes, but text is annoying to get out of blocks - are you just wanting the LISP to scour every block in the drawing?
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  10. #10
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    625

    Default

    Registered forum members do not see this ad.

    Not every block but selected blocks
    Sorry for my English.

Similar Threads

  1. Convert text to mtext in lisp?
    By muck in forum AutoLISP, Visual LISP & DCL
    Replies: 19
    Last Post: 27th Jul 2010, 09:31 am
  2. leader mtext .. lisp breaks in adt
    By au-s in forum AutoLISP, Visual LISP & DCL
    Replies: 7
    Last Post: 29th Jun 2009, 04:04 pm
  3. Lisp routine to convert objects into Text or Mtext
    By bsimpson in forum AutoLISP, Visual LISP & DCL
    Replies: 3
    Last Post: 2nd Feb 2009, 01:31 pm
  4. Can Lisp use mtext to make multi string mtext editor?
    By muck in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 18th Dec 2006, 03:22 am
  5. LT 2006- text to mtext lisp,
    By RONQUITECT in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 15th Apr 2006, 03:29 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts