TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: POCKETS on May 13, 2009, 01:30:22 PM
-
CAB,
I apologize for bothering you again but this problem will not go AWAY! At the command line, when I try to use PL2Cloud or Flexduct, I get "To few arguments". Two great programs and I can't use them. Any ideas?
Pockets
-
In the error function add ' (vl-bt) ', and then post what is returned to the command line. This may help Alan more.
-
Mr. Willey,
I don't understand what you are requesting. When it comes to lisp, what I know could be put in a thimble and a bulldozer driven in behind.
Pockets
-
If the code you are using looks like this
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 1.5 October 9,2007
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
[color=red];;; No error handler at this time[/color]
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun c:Flex (/ cl-ent ribWidth RibShort RibLong collar
dist steps ribFlag pt curAng curDer
RibPtLst1 RibPtLst2 p1 p2 doc space
cflag cl-len ribRadius tmp NewPline FlexLayer
pl1 pl2 cnt errflag InsulThick
)
Then add ( whats in red below ) to the code.
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 1.5 October 9,2007
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
;;; No error handler at this time
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun c:Flex (/ cl-ent ribWidth RibShort RibLong collar
dist steps ribFlag pt curAng curDer
RibPtLst1 RibPtLst2 p1 p2 doc space
cflag cl-len ribRadius tmp NewPline FlexLayer
pl1 pl2 cnt errflag InsulThick [color=red]*error*[/color]
)
[color=red](defun *error* (msg) (vl-bt))[/color]
And in the Pl2Cloud routine, in this area
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; if
(setvar "Plinewid" oldplw)
(setvar "blipmode" userbm) ;reset blipmode
(setvar "CMDECHO" usercmd)
(setvar "osmode" useros)
(setq pl2cloudglobal (put_saved_vars)
userbm nil
oldplw nil
usercmd nil
useros nil
)
(princ)
) ;end error function
Add to it like so
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; if
(setvar "Plinewid" oldplw)
(setvar "blipmode" userbm) ;reset blipmode
(setvar "CMDECHO" usercmd)
(setvar "osmode" useros)
(setq pl2cloudglobal (put_saved_vars)
userbm nil
oldplw nil
usercmd nil
useros nil
)
[color=red] (vl-bt)[/color]
(princ)
) ;end error function
This should help point stuff out.
-
Thanks Tim...
Pockets the last error handler posted by Tim is the one in Pl2cloud lisp.
Be sure to keep using version 27b & post the command line output after the error occurs.
-
This is what came up on the command line
Duct diameter is set to 2.0
Select center of flex duct [PLINE] [Diameter] Enter to quitBacktrace:
[0.49] (VL-BT)
[1.45] (*ERROR* "too few arguments")
[2.40] (_call-err-hook #<SUBR @06059fdc *ERROR*> "too few arguments")
[3.34] (sys-error "too few arguments")
:ERROR-BREAK.29 nil
[4.26] (TRANS (0.0 -10.7469 0.0) 0 1)
[5.19] (C:FLEX)
[6.15] (#<SUBR @0605a104 -rts_top->)
[7.12] (#<SUBR @02452334 veval-str-body> "(C:FLEX)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
-
This is what comes up for pl2cloud
Command: pl2cloud
*** Debug Mode ON. ***
Main Routine Started...
Global Vars Set...
Checking for DCL...
DCL File found...
Opening DCL File...
Pick Polyline to trace cloud:
>>> Make Cloud Sub
((-1 . <Entity name: 41ada168>) (0 . "LWPOLYLINE") (330 . <Entity name:
41afbcc8>) (5 . "129D") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
(100 . "AcDbPolyline") (90 . 2) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10
11.0591 2.8774) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 11.0591 12.2889) (40 .
0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
Check point 1
Check point 2
<Entity name: 41ada168>
0.0
0.495342
9.41149
1.0
Error: too few arguments
-
Thanks for the update.
In the routine pl2cloud27b find these lines:
(princ)
) ;end error function
and add this:
(vl-bt) ; Add this line
(princ)
) ;end error function
Then test again & post results.
-
Strange but this line looks OK to me.
Anyone see the cause of the error?
[4.26] (TRANS (0.0 -10.7469 0.0) 0 1)
-
Only if the ' trans ' function got re-defined??
Edit: Here is what is called, maybe the same on other comps. #<SUBR @0a43f808 TRANS>
-
T
*** Debug Mode ON. ***
Main Routine Started...
Global Vars Set...
Checking for DCL...
DCL File found...
Opening DCL File...
Pick Polyline to trace cloud:
>>> Make Cloud Sub
((-1 . <Entity name: 402d58d0>) (0 . "LWPOLYLINE") (330 . <Entity name:
402d0cf8>) (5 . "362") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
(100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10
22.6612 8.91265) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 31.3409 8.91265) (40 .
0.0) (41 . 0.0) (42 . 0.0) (10 31.3409 13.8397) (40 . 0.0) (41 . 0.0) (42 .
0.0) (10 22.6612 13.8397) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
Check point 1
Check point 2
<Entity name: 402d58d0>
0.0
0.494794
27.2137
4.0
Error: too few arguments
Backtrace:
[0.64] (VL-BT)
[1.60] (*ERROR* "too few arguments")
[2.55] (_call-err-hook #<SUBR @0616cab4 *ERROR*> "too few arguments")
[3.49] (sys-error "too few arguments")
:ERROR-BREAK.44 nil
[4.41] (TRANS (22.6612 8.91265 0.0) 0 1)
[5.34] (MAKECLOUD ((-1 . <Entity name: 402d58d0>) (0 . "LWPOLYLINE") (330 .
<Entity name: 402d0cf8>) (5 . "362") (100 . "AcDbEntity") (67 . 0) (410 .
"Model") (8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 .
0.0) (39 . 0.0) (10 22.6612 8.91265) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10
31.3409 8.91265) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 31.3409 13.8397) (40 .
0.0) (41 . 0.0) (42 . 0.0) (10 22.6612 13.8397) (40 . 0.0) (41 . 0.0) (42 .
0.0) (210 0.0 0.0 1.0)) nil)
[6.28] (DO_PICK_METHOD)
[7.24] (RUN_DIALOG "pl2cloud.dcl")
[8.19] (C:PL2CLOUD)
[9.15] (#<SUBR @0616d154 -rts_top->)
[10.12] (#<SUBR @02442334 veval-str-body> "(C:PL2CLOUD)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
-
What happens when you enter this at the command line?
(trans '( 1 1 0) 0 1)
-
It says "too few arguments"
-
Type ' !trans ' at the command line, and post back.
-
Well it could be a bug in your ACAD or some routine has hijacked the TRANS function. :-o
-
When I type '!trans' I get "lisp command not available"
Cab I'm thinking you're right that my AutoCAD has a bug
-
When I try using flexduct I get the following:
Duct diameter is set to 16.0
Select center line of flex duct.[Diameter]<16.0> Enter to quit.d
Specify duct diameter <16.0000>: 4
Duct diameter is set to 4.0
Select center line of flex duct.[Diameter]<4.0> Enter to quit.bad function:
VLAX-CURVE-GETPOINTATPARAM
Command:
The VLAX-CURVE-GETPOINTATPARAM also appears when I use pl2cloud27a
-
Try this test version. I removed the TRANS function.
-
CAB,
Thank you, Thank you!
Works like a charm
Pockets
-
OK see attached a special version of pl2cloud with the trans removed.
-
For those that need the TRANS see attached the latest version, and debug code turned OFF.
-
CAB,
Again, Thank you, Thank you!
It works!!!!!!
-
Maybe search through all your lisp codes that run within acad, and see if you have anything that has ' defun trans '. I can't believe anyone would do that, but maybe one of the codes you are using has it, which caused this problem.
-
That I shall do.
Many thanks to you as well.
Pockets
-
T. Willey
Another thought just came to mind. Do I delete the DEFUN TRANS? Is there any text associated with DEFUN TRANS?
Again, Thanks
Pockets
-
I would do a text search of all lisp files with the following:
Files: *.lsp
Text: "defun (trans"
See if you get any hits. If so, then open that file, or better yet post that file here & we will see if it can be cleaned up.
-
I would do a text search of all lisp files with the following:
Files: *.lsp
Text: "defun (trans"
See if you get any hits. If so, then open that file, or better yet post that file here & we will see if it can be cleaned up.
Don't put the parenthesis before ' trans '. Below is how you should search. I think Alan just typed too fast. :wink:
Files: *.lsp
Text: "defun trans"
T. Willey
Another thought just came to mind. Do I delete the DEFUN TRANS? Is there any text associated with DEFUN TRANS?
Again, Thanks
Pockets
As for deleting it, I would say no. I would just rename it, and then make sure you change all the calls to it within that lisp function. If you delete it, the lisp won't work as it should.
-
Thanks Tim you're quite right. :)
Use defun trans as Tim siggested.
-
Again,
Many thanks to the both of you.
Pockets
-
...and again, I show my ignorance. How do you do a text search? I did a search using the start up search program for file and folders and found nothing.
Pockets
-
...and again, I show my ignorance. How do you do a text search? I did a search using the start up search program for file and folders and found nothing.
Pockets
I'm with you on this one though. I have seen it described, but have never done it, so maybe someone who has will be nice enough to chime in.
-
...and again, I show my ignorance. How do you do a text search? I did a search using the start up search program for file and folders and found nothing.
Pockets
I'm with you on this one though. I have seen it described, but have never done it, so maybe someone who has will be nice enough to chime in.
http://www.kellys-korner-xp.com/xp_s.htm
Scroll down to SEARCH - ALL FILE TYPES. Might be of some help...??
-
Using FileExployer
(http://www.theswamp.org/screens/index.php?dir=cab/&file=File%20Search.png)
You may need to search other folders depending on where you keep your lisp files.
-
Using FileExployer
(http://www.theswamp.org/screens/index.php?dir=cab/&file=File%20Search.png)
You may need to search other folders depending on where you keep your lisp files.
If only it worked. :|
-
CAB,
That's the way I did my search and I came up empty. So, I would say that was a good thing.
Pocketw
-
Hi
Here's a little LISP to make text searchs from AutoCAD
(http://img17.imageshack.us/img17/2969/searchx.png)
;; SEARCH (gile)
;; Search for a string in a directory (and sub-directories)
;; Returns the list of the files which countain the string
(defun c:search (/ path lst rslt file line)
(and
(setq path (dirbox "Select a directory" "" 512))
(setq lst (searchbox))
(setq rslt "")
(mapcar
(function
(lambda (d)
(mapcar
'(lambda (f)
(setq file (open (strcat d "\\" f) "r")
loop T
)
(while (and loop (setq line (read-line file)))
(if
(vl-string-search (strcase (cadr lst)) (strcase line))
(setq rslt (strcat rslt d "\\" f "\n")
loop nil
)
)
)
(close file)
)
(vl-directory-files d (car lst))
)
)
)
(cons path (getfolders path))
)
(and (/= "" rslt) (princ rslt) (textscr))
)
(princ)
)
(defun SearchBox (/ temp file dcl_id ext pat lst)
(setq temp (vl-filename-mktemp "Tmp.dcl")
file (open temp "w")
)
(write-line
"SearchBox
:dialog{label=\"Search\";initial_focus=\"ext\";
:row{
:text{label=\"File type\";}
:edit_box{key=\"ext\";edit_width=15;allow_accept=true;}
}
spacer;
:text{label=\"Text to search\";}
:edit_box{key=\"pat\";edit_width=40;allow_accept=true;}
spacer;
ok_cancel;}"
file
)
(close file)
(setq dcl_id (load_dialog temp))
(if (not (new_dialog "SearchBox" dcl_id))
(exit)
)
(action_tile
"accept"
"(setq lst (list (get_tile \"ext\") (get_tile \"pat\"))) (done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete temp)
lst
)
;;; DirBox -Patrick_35-
(defun DirBox (Message Chemin Drapeau / rep sh)
(setq sh (vlax-create-object "Shell.Application"))
(if (setq
rep (vlax-invoke sh 'browseforfolder 0 Message Drapeau Chemin)
)
(setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
(setq rep nil)
)
(vlax-release-object sh)
rep
)
;;; GetFolders (gile)
;;; Returns the list of all sub-folders of the specified folder (or drive)
(defun GetFolders (path / c)
(apply 'append
(mapcar
(function
(lambda (x)
(cons (setq c (strcat path "\\" x)) (GetFolders c))
)
)
(vl-remove "."
(vl-remove ".." (vl-directory-files path nil -1))
)
)
)
)
-
If only it worked. :|
The reason it worked for Alan but not for you is because Alan is using Windows 2000, and you are using Windows XP. In XP and Vista you have to screw around in the registry to get search to look inside of lisp souce files. I'll see if I can find the article that explains how to fix this and post a link.
-
Gile,
Thank You.
The search program works great. I found one lisp with a defun trans attached.
...and here it is:
; The following program is written as an aid to finding occurances of
; a string within an Autocad drawing. Strings which are part of
; primary text entities, attributes, and blocks (one level deep) are found.
;
; The user is prompted to enter a target string, pick a base point and
; indicate whether blocks are to be searched. The target string is the
; string of text you want to find. Using upper or lower case does not
; affect the results. The program uses the base point you select to draw
; lines to the insertion point of all text entities which contain the
; target string.
;
;
;
(defun trans (base ip scale rang tbase / dist ang xr yr pt2)
(setq dist (* (distance base tbase) scale)
ang (angle base tbase)
xr (+ (car ip) (* dist (cos (+ ang rang))))
yr (+ (cadr ip) (* dist (sin (+ ang rang))))
pt2 (list xr yr)
)
)
(defun match (target test / tstlen tarlen dif z ind temp )
(setq tstlen (strlen test)
tarlen (strlen target)
dif (+ (- tstlen tarlen) 1)
z 1
ind 0
v 'Q
)
(if (> dif 0)
(repeat dif
(while z
(setq ind (+ ind 1)
temp (substr test ind tarlen)
)
(if (= temp target)
(setq v 'T
z nil
)
)
(if (>= ind tstlen)(setq z nil))
)
)
)
(eval v)
)
(defun c:fndtxt (/ p1 ss1 ss2 ss3 ss1len ss2len ss3len index mat target
test p2 name atfl ent blknm blkstuf base ename tbase
count en2 bname ip scale rang i ques
)
(graphscr)
(setvar "cmdecho" 0)
(setq target (strcase (getstring T "\nEnter target string: "))
p1 (getpoint "\nPick base point for marks ")
ques (strcase (substr (getstring "\nDo you wish to search blocks too? <Y>: ") 1 1))
)
(if (= ques "")(setq ques "Y"))
(prompt "\nCreating selection sets -Please wait ")
(setq ss1 (ssget "x" '((0 . "TEXT")))
ss1len (if (/= ss1 nil)(sslength ss1)(eval 0))
index -1
mat 0
)
(prompt (strcat "\nNumber of text entities in drawing: " (itoa ss1len)))
(prompt (strcat "\n Entities checked Matches found for <"
target ">"
)
)
(terpri)
(repeat ss1len
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
(setq index (+ index 1)
test (strcase (cdr (assoc 1 (entget (ssname ss1 index)))))
)
(if (match target test)
(progn
(setq p2 (cdr (assoc 10 (entget (ssname ss1 index))))
mat (+ mat 1)
)
(command "line" p1 p2 "")
)
)
)
(if (= ques "Y")
(progn
(prompt "\nChecking blocks for attributes: ")
(setq ss2 (ssget "x" '((0 . "INSERT")))
ss2len (if (/= ss2 nil)(sslength ss2)(eval 0))
)
(prompt (strcat "\n Blocks checked Matches found for <"
target ">"
)
)
(terpri)
(setq index -1)
(repeat ss2len
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
(setq index (+ index 1)
name (ssname ss2 index)
atfl (cdr (assoc 66 (setq ent (entget name))))
)
(if (= atfl 1)
(while (/= (cdr (assoc 0 ent)) "SEQEND")
(if (= (cdr (assoc 0 ent)) "ATTRIB")
(if (match target (strcase (cdr (assoc 1 ent))))
(progn
(command "line" p1 (cdr (assoc 10 ent)) "")
(setq mat (+ mat 1))
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
)
)
)
(setq ent (entget (setq name (entnext name))))
)
)
)
(setq index -1)
(repeat ss2len
(setq index (+ index 1)
name (ssname ss2 index)
blknm (cdr (assoc 2 (entget name)))
)
(setq i (substr blknm 1 1))
(if (and (not (member blknm ss3)) (/= i "*"))(setq ss3 (cons blknm ss3)))
)
(prompt (strcat "\nChecking " (itoa (length ss3)) " blocks for imbedded text: " ))
(prompt (strcat "\nBlock Entities checked Matches found for <"
target ">"
)
)
(terpri)
(setq index -1)
(repeat (length ss3)
(setq index (+ index 1)
blknm (nth index ss3)
blkstuf (tblsearch "block" blknm)
base (cdr (assoc 10 blkstuf))
ename (cdr (assoc -2 blkstuf))
)
(setq i -1)
(while ename
(setq i (+ i 1))
(prompt (strcat "\r" blknm " " (itoa i) " "(itoa mat))
)
(setq ent (entget ename))
(if (= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq test (cdr (assoc 1 ent)))
(if (match target test)
(progn
(setq tbase (cdr (assoc 10 ent))
count -1
)
(repeat ss2len
(setq count (+ count 1)
en2 (ssname ss2 count)
bname (cdr (assoc 2 (entget en2)))
)
(if (= bname blknm)
(progn
(setq ip (cdr (assoc 10 (entget en2)))
scale (cdr (assoc 41 (entget en2)))
rang (cdr (assoc 50 (entget en2)))
)
(command "line" p1 (trans base ip scale rang tbase) "")
(setq mat (+ mat 1))
(prompt (strcat "\r" blknm " "(itoa i)
" "(itoa mat)
)
)
)
)
)
)
)
)
)
(setq ename (entnext ename))
)
)
)
)
(princ)
)
-
If only it worked. :|
The reason it worked for Alan but not for you is because Alan is using Windows 2000, and you are using Windows XP. In XP and Vista you have to screw around in the registry to get search to look inside of lisp souce files. I'll see if I can find the article that explains how to fix this and post a link.
I found one hot-fix, but that was for searching within Excel files. Oh, well. Not a big deal (for me anyways) since I can't hack the registry here. I can't even see my C:\ drive - they've got that "hidden" from us so we don't accidentally delete any important DLLs. :lol:
-
Wow, thanks Gile, very nice..
Pockets, here is the revised/repaired LISP.
Distroy the other copy!
; The following program is written as an aid to finding occurances of
; a string within an Autocad drawing. Strings which are part of
; primary text entities, attributes, and blocks (one level deep) are found.
;
; The user is prompted to enter a target string, pick a base point and
; indicate whether blocks are to be searched. The target string is the
; string of text you want to find. Using upper or lower case does not
; affect the results. The program uses the base point you select to draw
; lines to the insertion point of all text entities which contain the
; target string.
;
;
;
(defun c:fndtxt (/ p1 ss1 ss2 ss3 ss1len ss2len ss3len index mat target
test p2 name atfl ent blknm blkstuf base ename tbase
count en2 bname ip scale rang i ques transl match
)
(defun transl (base ip scale rang tbase / dist ang xr yr pt2)
(setq dist (* (distance base tbase) scale)
ang (angle base tbase)
xr (+ (car ip) (* dist (cos (+ ang rang))))
yr (+ (cadr ip) (* dist (sin (+ ang rang))))
pt2 (list xr yr)
)
)
(defun match (target test / tstlen tarlen dif z ind temp )
(setq tstlen (strlen test)
tarlen (strlen target)
dif (+ (- tstlen tarlen) 1)
z 1
ind 0
v 'Q
)
(if (> dif 0)
(repeat dif
(while z
(setq ind (+ ind 1)
temp (substr test ind tarlen)
)
(if (= temp target)
(setq v 'T
z nil
)
)
(if (>= ind tstlen)(setq z nil))
)
)
)
(eval v)
)
(graphscr)
(setvar "cmdecho" 0)
(setq target (strcase (getstring T "\nEnter target string: "))
p1 (getpoint "\nPick base point for marks ")
ques (strcase (substr (getstring "\nDo you wish to search blocks too? <Y>: ") 1 1))
)
(if (= ques "")(setq ques "Y"))
(prompt "\nCreating selection sets -Please wait ")
(setq ss1 (ssget "x" '((0 . "TEXT")))
ss1len (if (/= ss1 nil)(sslength ss1)(eval 0))
index -1
mat 0
)
(prompt (strcat "\nNumber of text entities in drawing: " (itoa ss1len)))
(prompt (strcat "\n Entities checked Matches found for <"
target ">"
)
)
(terpri)
(repeat ss1len
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
(setq index (+ index 1)
test (strcase (cdr (assoc 1 (entget (ssname ss1 index)))))
)
(if (match target test)
(progn
(setq p2 (cdr (assoc 10 (entget (ssname ss1 index))))
mat (+ mat 1)
)
(command "line" p1 p2 "")
)
)
)
(if (= ques "Y")
(progn
(prompt "\nChecking blocks for attributes: ")
(setq ss2 (ssget "x" '((0 . "INSERT")))
ss2len (if (/= ss2 nil)(sslength ss2)(eval 0))
)
(prompt (strcat "\n Blocks checked Matches found for <"
target ">"
)
)
(terpri)
(setq index -1)
(repeat ss2len
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
(setq index (+ index 1)
name (ssname ss2 index)
atfl (cdr (assoc 66 (setq ent (entget name))))
)
(if (= atfl 1)
(while (/= (cdr (assoc 0 ent)) "SEQEND")
(if (= (cdr (assoc 0 ent)) "ATTRIB")
(if (match target (strcase (cdr (assoc 1 ent))))
(progn
(command "line" p1 (cdr (assoc 10 ent)) "")
(setq mat (+ mat 1))
(prompt (strcat "\r " (itoa (+ index 2))
" "(itoa mat)
)
)
)
)
)
(setq ent (entget (setq name (entnext name))))
)
)
)
(setq index -1)
(repeat ss2len
(setq index (+ index 1)
name (ssname ss2 index)
blknm (cdr (assoc 2 (entget name)))
)
(setq i (substr blknm 1 1))
(if (and (not (member blknm ss3)) (/= i "*"))(setq ss3 (cons blknm ss3)))
)
(prompt (strcat "\nChecking " (itoa (length ss3)) " blocks for imbedded text: " ))
(prompt (strcat "\nBlock Entities checked Matches found for <"
target ">"
)
)
(terpri)
(setq index -1)
(repeat (length ss3)
(setq index (+ index 1)
blknm (nth index ss3)
blkstuf (tblsearch "block" blknm)
base (cdr (assoc 10 blkstuf))
ename (cdr (assoc -2 blkstuf))
)
(setq i -1)
(while ename
(setq i (+ i 1))
(prompt (strcat "\r" blknm " " (itoa i) " "(itoa mat))
)
(setq ent (entget ename))
(if (= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq test (cdr (assoc 1 ent)))
(if (match target test)
(progn
(setq tbase (cdr (assoc 10 ent))
count -1
)
(repeat ss2len
(setq count (+ count 1)
en2 (ssname ss2 count)
bname (cdr (assoc 2 (entget en2)))
)
(if (= bname blknm)
(progn
(setq ip (cdr (assoc 10 (entget en2)))
scale (cdr (assoc 41 (entget en2)))
rang (cdr (assoc 50 (entget en2)))
)
(command "line" p1 (transl base ip scale rang tbase) "")
(setq mat (+ mat 1))
(prompt (strcat "\r" blknm " "(itoa i)
" "(itoa mat)
)
)
)
)
)
)
)
)
)
(setq ename (entnext ename))
)
)
)
)
(princ)
)
-
You're welcome POCKETS.
I suggest you rename this trans function (findtxt_trans for example) and you replace the only call to this function (about the end of the code):
(command "line" p1 (trans base ip scale rang tbase) "")
by
(command "line" p1 (findtxt_trans base ip scale rang tbase) "")
trans is a very usefull pre defined LISP function, it's a shame to redefine it !
<EDIT>: CAB was faster...
-
Again,
Many, many thanks to all (CAB, T. WILLEY, GILES)
-
You're welcome for my part. I'm just glad we found what the issue was.
-
I can't believe someone would redefine the trans function... glad you got it sorted Pockets, lets just hope there aren't any other functions that have been redefined...
-
Just adding, ultraedit got a nice find in files feature and even vlide has a built in same function too.
-
:-D thx :wink:
-
Just adding, ultraedit got a nice find in files feature and even vlide has a built in same function too.
Thanks for pointing that out. Just tried it & it's very fast.
-
you're welcome cab, thanks also to gile for sharing his code.... :-)