Utilizing AutoCAD's FIND feature in lisp routines?

[Comatosis]

Hello all,

 

I'm trying to come up with a lisp routine to do something I've been doing so far with the find feature. Essentially, I'm searching for a string of text in block attributes and in a single, somewhat large MTEXT object--large enough for its content to be split into multiple "type 3" group codes (sorry for the poor description, I'm a lisp noob ). For those of you in construction design/drafting, I'm checking to make sure that I'm not missing any keyed notes or their references in my drawings.

 

The find feature gets me close to what I want, but ideally I'd like to be able to just spit out a table that tells me whether or not I'm missing keyed notes/references. I imagine there should be a way to replicate the functionality of Find in lisp such that I can tweak the code to suit my needs.

 

Unfortunately, I don't have any code to share at the moment because I'm home and all my stuff is at work. Plus, I started messing with lisp literally yesterday and am a complete novice. I might swing by the office later on and show you guys what I've been working on, but in the meantime I figured I'd check with the pros whether or not this is even doable in the first place.

 

Thanks in advance.

[Lee Mac]

Hi Comatosis, welcome to the CADTutor forums

 

A little overkill for your task, but you could use my Batch Find & Replace program which may be found here with the 'Search Only' option ticked to produce a report detailing the occurrences of your search strings.

 

AFAIK, there is no way to call the Find command from within LISP, so you would have to create your own Find function. This can be accomplished using such functions as vl-string-search, vl-string-subst, wcmatch, substr, etc. But there are other factors to consider such as formatting codes embedded in MText strings. I've spent many hours trying to overcome such difficulties with my BFind program, which should be successfully with all but the most heavily formatted objects.

 

Hope this helps,

 

Lee

[Comatosis]

Thanks for the program and the suggestions. I'll keep trying to write this up on my own to get the practice, heh.

 

Speaking of which, is there a way to gather up all the group code 3 attributes/subentities (or whatever they're called) and combine them into one?

This is more or less what I was trying to do:

 

(setq entList (entget (car (entsel))))  ;choose the MTEXT
(setq ent_text (assoc 3 entList))

 

But all I could get into ent_text was the first one (or multiple copies of the first one after trying to use a foreach loop). How can I tell it to move on to the next group code 3 items and add them to ent_text? The way I was envisioning this was first making a huge list/string with all the text and then extracting the substrings I want (assuming it lets me use wildcards) into another list that I would then manipulate into a table or output of sorts.

[pBe]

We are using Architectural/Engineering units working with MTEXTS formatting .

 

Try changing all 1/4" to 3/8" with stack properties turned ON using _find

 

EDIT:

Apparently it doesnt work with Bfind as well

 

Lee,

 

Is there a way to include this option your code? for the meantime i'll try to write a routine for this if i can.

 

Cheers

 

 

 

 

 

 

1/4

1/4

Edited August 20, 2011 by pBe

[Lee Mac]

Try changing all 1/4" to 3/8" with stack properties turned ON using _find

 

Apparently it doesnt work with Bfind as well

 

Yeah, there are still some bugs with stacking formatting codes

[Lee Mac]

Speaking of which, is there a way to gather up all the group code 3 attributes/subentities (or whatever they're called) and combine them into one?

 

You could use a 'massoc' function, which may be something along the lines of:

 

(defun mAssoc ( key lst )
   (apply 'append (mapcar '(lambda ( x ) (if (eq key (car x)) (list (cdr x)))) lst))
)

Or, recursively:

 

(defun mAssoc ( key lst / item )
   (if (setq item (assoc key lst))
       (cons (cdr item) (mAssoc key (cdr (member item lst))))
   )
)

Example:

 

_$ (setq l '((1 . "ABC") (2 . "DEF") (3 . "GHI") (2 . "JKL") (2 . "MNO")))
((1 . "ABC") (2 . "DEF") (3 . "GHI") (2 . "JKL") (2 . "MNO"))

_$ (mAssoc 2 l)
("DEF" "JKL" "MNO")

So, for combining the strings:

 

_$ (apply 'strcat (mAssoc 2 l))
"DEFJKLMNO"

 

Or, you could construct the string whilst iterating through the entity data:

 

(defun gettextstring ( ent / str )
   (setq str "")
   (foreach x (entget ent)
       (if (member (car x) '(1 3))
           (setq str (strcat str (cdr x)))
       )
   )
   str
)

 

(if (setq en (car (entsel)))
   (gettextstring en)
)

[Comatosis]

Maaaan, that response is completely awesome. I'll see about heading to work tomorrow and coming up with something. My guess is I'll be back for help soon afterwards.

 

Thanks a lot for the help.

[irneb]

The old way of getting to same named assoc items would be to use the member function. It basically returns the list starting from the first occurrence of the item. Then you get the "remainder" of the list with cdr. And then performing an assoc again.

 

Lee's suggestion of using the massoc (user defined function) helps by extracting all code 3 (say) tags. Then you could use a foreach on that.

 

In both cases you'd then use strcat to concatenate them into a single string. Remember to split into multiple 3 codes of 255 (max length) again if you then want to entmake or entmod.

[pBe]

We are using Architectural/Engineering units working with MTEXTS formatting .

Try changing all 1/4" to 3/8" ....... i'll try to write a routine for this if i can.

 

 

Here's a draft

 

(defun c:FindFrac  (/ aDoc OldFrac NewFrac objs sstr strt str _old _new )
(vl-load-com)
     (setq aDoc (vla-get-activedocument (vlax-get-acad-object)))
     (cond ((and
       (setq OldFrac (getstring "\nEnter Fraction to Replace: "))
       (setq NewFrac (getstring "\nEnter New Fraction to Substitute: "))
       (ssget ":L" '((0 . "MTEXT")))
            (vlax-for
                   txts  (setq objs (vla-get-activeselectionset aDoc))
                  (setq sstr (vla-get-textstring txts) strp 1)
                  (while
                        (setq strt (vl-string-search "[url="file://\\S"]\\S[/url]" sstr strp))
                             (setq _old OldFrac _new NewFrac)
                             (setq str  (substr (setq val  (substr sstr
                                                                   (+ strt 3)))
                                                1
                                                (vl-string-search ";" val)))
                             (if (vl-string-search "#" str)
                                   (setq _new (vl-string-subst "#" "/" _new)
                                         _old (vl-string-subst "#" "/" _old)))
                             (if (equal _old str)
                                   (progn
                                         (setq sstr (vl-string-subst
                                                          _new
                                                          str
                                                          sstr))
                                         (vla-put-textstring txts sstr))
                                   )
                             (setq strp (+ strt 3))
                             )
                  )
            (vla-delete objs)

           )
               )
            )
              (princ)
     )

 

command: _FindFrac

Enter Fraction to Replace: 1/8

Enter New Fraction to Substitute: 3/4

select objects:

 

I works exclusively on MTEXT with stacked format. (horizonatl/diagonal)

 

You may wonder what this line is for (setq _old OldFrac _new NewFrac). some of our guys here tends to combine diagonal and vertical stacking on one pharagraph/sentence. the value "/" will be change to "#" once the if statement is true and revert back to "/" after the loop (its one or the other)

 

For your comments and suggestions.

Need you guys to try it out so i can make improvements...

 

Cheers

Edited August 21, 2011 by pBe

[Lee Mac]

Maaaan, that response is completely awesome. I'll see about heading to work tomorrow and coming up with something. My guess is I'll be back for help soon afterwards.

 

Thanks a lot for the help.

 

You're very welcome, glad it helps

[Lee Mac]

(defun c:FindFrac <... snip ...>

For your comments and suggestions.

Need you guys to try it out so i can make improvements...

 

I would be inclined to use the power of Regular Expressions for this task:

 

([color=BLUE]defun[/color] c:FindStacked

   [color=GREEN];; Find Stacked  -  Lee Mac 2011  -  www.lee-mac.com[/color]

   ( [color=BLUE]/[/color] *error* _prompt _replace _dissect _textstring ent inc new old rgx sel str )

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]and[/color] rgx ([color=BLUE]not[/color] ([color=BLUE]vlax-object-released-p[/color] rgx))) ([color=BLUE]vlax-release-object[/color] rgx))
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )

   ([color=BLUE]defun[/color] _prompt ( msg [color=BLUE]/[/color] var )
       ([color=BLUE]while[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-string-position[/color] 47 ([color=BLUE]setq[/color] var ([color=BLUE]getstring[/color] msg))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nPlease Enter a Fractional String."[/color])
       )
       ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]strlen[/color] var)) var)
   )

   ([color=BLUE]defun[/color] _dissect ( str [color=BLUE]/[/color] pos )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-position[/color] 47 str))
           ([color=BLUE]list[/color] ([color=BLUE]substr[/color] str 1 pos) ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 2 pos)))
       )
   )

   ([color=BLUE]defun[/color] _textstring ( elist [color=BLUE]/[/color] lst )
       ([color=BLUE]foreach[/color] pair elist
           ([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]car[/color] pair) '(1 3))
               ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] pair) lst))
           )
       )
       ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]reverse[/color] lst))
   )

   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] old (_prompt [color=MAROON]"\nSpecify Fraction to Replace: "[/color]))
           ([color=BLUE]setq[/color] new (_prompt [color=MAROON]"\nSpecify Fraction to Substitute: "[/color]))
           ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"MTEXT"[/color]) (1 . [color=MAROON]"*\\S*"[/color]))))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] rgx ([color=BLUE]vlax-get-or-create-object[/color] [color=MAROON]"VBScript.RegExp"[/color]))
           ([color=BLUE]vlax-put-property[/color] rgx 'global     [color=BLUE]actrue[/color])
           ([color=BLUE]vlax-put-property[/color] rgx 'ignorecase [color=BLUE]actrue[/color])
           ([color=BLUE]vlax-put-property[/color] rgx 'multiline  [color=BLUE]actrue[/color])

           ([color=BLUE]setq[/color] old (_dissect old)
                 new (_dissect new)
                 new ([color=BLUE]strcat[/color] [color=MAROON]"\\S"[/color] ([color=BLUE]car[/color] new) [color=MAROON]"$1"[/color] ([color=BLUE]cadr[/color] new) [color=MAROON]";"[/color])
           )
           ([color=BLUE]vlax-put-property[/color] rgx 'pattern ([color=BLUE]strcat[/color] [color=MAROON]"\\\\S"[/color] ([color=BLUE]car[/color] old) [color=MAROON]"([/#\\^])"[/color] ([color=BLUE]cadr[/color] old) [color=MAROON]";"[/color]))

           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc)))
                     str (_textstring ([color=BLUE]entget[/color] ent))
               )
               ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]eq[/color] str ([color=BLUE]setq[/color] str ([color=BLUE]vlax-invoke[/color] rgx 'replace str new))))
                   ([color=BLUE]vla-put-textstring[/color] ([color=BLUE]vlax-ename->vla-object[/color] ent) str)
               )
           )
           ([color=BLUE]vlax-release-object[/color] rgx)
       )
   )
   ([color=BLUE]princ[/color])
)

I have retained simplicity in the above code for clarity and consequently it is by no means bullet-proof. For a full application, I would include code to account for literal occurrences of "\\S" in the MText string, and occurrences of "/" amongst other characters in the numerator and denominator of the fraction; but above all, the code demonstrates the method I would follow.

[pBe]

Regular Expressions..

 

I never did get around exploring that method... yeah why not.

 

BTW: with codes utilizing VBScript and also ActiveX, would it still work for Autocad MAC versions?

 

EDIT: wrong Expression (pun)

Edited August 21, 2011 by pBe

[irneb]

Definitely no. There won't be any ActiveX over there so the vlax-get-or-create-object would already fail. Never mind that there also isn't anything like VBScript.RegExp to play with.

 

Edit: Painful ain't it? Another reason I'd like to see a Common Lisp interpreter inside AutoCAD: http://www.cliki.net/regular%20expression

[Lee Mac]

Regular Expressions..

 

I never did get around exploring that method... yeah why not.

 

Eye-roll?

[pBe]

Eye-roll?

 

Oh... i meant

 

I never did once use RegEx, even though i'm aware of it for sometime now

 

Humble apoligies Lee

 

EDIT: POST updated

[pBe]

Definitely no. There won't be any ActiveX over there so the vlax-get-or-create-object would already fail. Never mind that there also isn't anything like VBScript.RegExp to play with.

 

Edit: Painful ain't it? Another reason I'd like to see a Common Lisp interpreter inside AutoCAD: http://www.cliki.net/regular%20expression

 

Will it be the same case for NET?

[irneb]

Will it be the same case for NET?

Well, "at present" yes.

 

If you glance at the video tutorial for making stuff in OSX: http://wikihelp.autodesk.com/AutoCAD_for_Mac/enu/2011/Help/Developer_Documentation/Migrating_Windows_Applications/ObjectARX_-_Mac_OS_X_Migration_Guide/Required_Development_Tools

 

You'll note they "glance over" the fact that none of DotNet works anywhere else than in Windows! Though they mention something about "AutoDesk is working on resolving this". I just wonder how long they've been "working" on it? And if there's any sort of progress. I know the biggest reason behind most programs not running in Linux through WINE is due to DotNet requirements, and WINE has been going at it for some years already. So I'm not holding my breath on the DotNet in OSX score!

[Lee Mac]

Oh... i meant

 

I never did once use RegEx, even though i'm aware of it for sometime now

 

Humble apoligies Lee

 

EDIT: POST updated

 

lol, no worries dude, just couldn't work out the tone of your original response was all

 

For tasks like these, Regular Expressions are well worth studying though - string substitution becomes a lot easier.

[pBe]

If you glance at the video tutorial for making stuff in OSX: http://wikihelp.autodesk.com/AutoCAD_for_Mac/enu/2011/Help/Developer_Documentation/Migrating_Windows_Applications/ObjectARX_-_Mac_OS_X_Migration_Guide/Required_Development_Tools

 

Thanks for the info Irneb.

 

For tasks like these, Regular Expressions are well worth studying though - string substitution becomes a lot easier.

 

I'll start reading on RegEx this week.

Thanks my friend

[Lee Mac]

I'll start reading on RegEx this week.

Thanks my friend

 

You're very welcome

 

To get you started, here is the MSDN reference for the RegExp object itself:

 

http://msdn.microsoft.com/en-us/library/yab2dx62%28VS.85%29.aspx

 

And here is one of the very best RegEx tutorials I've seen:

 

http://www.theswamp.org/index.php?topic=37030.msg420224#msg420224