See the top rated post in this thread. Click here

Results 1 to 8 of 8

Thread: Help with Code loop

  1. 2014-02-11, 08:50 PM #1
    lblakely391485
    lblakely391485 is offline
    Member
    Join Date
    2012-07
    Location
    Chattanooga
    Posts
    9
    Login to Give a bone
    0

    Default Help with Code loop

    Hello,
    My knowledge of lisp is nothing...so.
    If it's possible, is anyone willing to show me a way to shorten this code with a loop?
    Any help appreciated, Thanks.

    Code:
     
 (defun c:EAB()
(setq newfile111(getstring "\nFile name to open in z:\\AB\\xxx\\AB"))
(setq newfile111(strcat "z:\\AB\\xxx\\AB" newfile111))
;(command "qsave")
(SETVAR "FILEDIA" 0)

(SETQ FILE31 (FINDFILE (STRCAT NEWFILE111 "A" ".15" ".DWG")))  
(SETQ FILE30 (FINDFILE (STRCAT NEWFILE111 "P" ".15" ".DWG")))
(SETQ FILE29 (FINDFILE (STRCAT NEWFILE111 "A" ".14" ".DWG")))
(SETQ FILE28 (FINDFILE (STRCAT NEWFILE111 "P" ".14" ".DWG")))
(SETQ FILE27 (FINDFILE (STRCAT NEWFILE111 "A" ".13" ".DWG")))  
(SETQ FILE26 (FINDFILE (STRCAT NEWFILE111 "P" ".13" ".DWG")))
(SETQ FILE25 (FINDFILE (STRCAT NEWFILE111 "A" ".12" ".DWG")))  
(SETQ FILE24 (FINDFILE (STRCAT NEWFILE111 "P" ".12" ".DWG")))  
(SETQ FILE23 (FINDFILE (STRCAT NEWFILE111 "A" ".11" ".DWG")))
(SETQ FILE22 (FINDFILE (STRCAT NEWFILE111 "P" ".11" ".DWG")))  
(SETQ FILE21 (FINDFILE (STRCAT NEWFILE111 "A" ".10" ".DWG")))
(SETQ FILE20 (FINDFILE (STRCAT NEWFILE111 "P" ".10" ".DWG")))
(SETQ FILE19 (FINDFILE (STRCAT NEWFILE111 "A" ".09" ".DWG")))
(SETQ FILE18 (FINDFILE (STRCAT NEWFILE111 "P" ".09" ".DWG")))  
(SETQ FILE17 (FINDFILE (STRCAT NEWFILE111 "A" ".08" ".DWG")))
(SETQ FILE16 (FINDFILE (STRCAT NEWFILE111 "P" ".08" ".DWG")))  
(SETQ FILE15 (FINDFILE (STRCAT NEWFILE111 "A" ".07" ".DWG")))
(SETQ FILE14 (FINDFILE (STRCAT NEWFILE111 "P" ".07" ".DWG")))
(SETQ FILE13 (FINDFILE (STRCAT NEWFILE111 "A" ".06" ".DWG")))
(SETQ FILE12 (FINDFILE (STRCAT NEWFILE111 "P" ".06" ".DWG"))) 
(SETQ FILE11 (FINDFILE (STRCAT NEWFILE111 "A" ".05" ".DWG")))
(SETQ FILE10 (FINDFILE (STRCAT NEWFILE111 "P" ".05" ".DWG")))  
(SETQ FILE09 (FINDFILE (STRCAT NEWFILE111 "A" ".04" ".DWG")))
(SETQ FILE08 (FINDFILE (STRCAT NEWFILE111 "P" ".04" ".DWG")))
(SETQ FILE07 (FINDFILE (STRCAT NEWFILE111 "A" ".03" ".DWG")))
(SETQ FILE06 (FINDFILE (STRCAT NEWFILE111 "P" ".03" ".DWG")))  
(SETQ FILE05 (FINDFILE (STRCAT NEWFILE111 "A" ".02" ".DWG")))
(SETQ FILE04 (FINDFILE (STRCAT NEWFILE111 "P" ".02" ".DWG")))  
(SETQ FILE03 (FINDFILE (STRCAT NEWFILE111 "A" ".01" ".DWG")))
(SETQ FILE02 (FINDFILE (STRCAT NEWFILE111 "P" ".01" ".DWG")))
(SETQ FILE01 (FINDFILE (STRCAT NEWFILE111 "A" ".00" ".DWG")))
(SETQ FILE00 (FINDFILE (STRCAT NEWFILE111 "P" ".00" ".DWG")))  
(SETQ FILE (FINDFILE (STRCAT NEWFILE111 "" ".DWG")))

(IF (/= FILE31 NIL) 
(PROGN 
  (SETQ newfile111 FILE31)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE30 NIL) 
(PROGN 
  (SETQ newfile111 FILE30)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE29 NIL) 
(PROGN 
  (SETQ newfile111 FILE29)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE28 NIL) 
(PROGN 
  (SETQ newfile111 FILE28)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE27 NIL) 
(PROGN 
  (SETQ newfile111 FILE27)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE26 NIL) 
(PROGN 
  (SETQ newfile111 FILE26)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE25 NIL) 
(PROGN 
  (SETQ newfile111 FILE25)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE24 NIL) 
(PROGN 
  (SETQ newfile111 FILE24)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE23 NIL) 
(PROGN 
  (SETQ newfile111 FILE23)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE22 NIL) 
(PROGN 
  (SETQ newfile111 FILE22)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE21 NIL) 
(PROGN 
  (SETQ newfile111 FILE21)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE20 NIL) 
(PROGN 
  (SETQ newfile111 FILE20)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE19 NIL) 
(PROGN 
  (SETQ newfile111 FILE19)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE18 NIL) 
(PROGN 
  (SETQ newfile111 FILE18)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE17 NIL) 
(PROGN 
  (SETQ newfile111 FILE17)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE16 NIL) 
(PROGN 
  (SETQ newfile111 FILE16)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE15 NIL) 
(PROGN 
  (SETQ newfile111 FILE15)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE14 NIL) 
(PROGN 
  (SETQ newfile111 FILE14)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE13 NIL) 
(PROGN 
  (SETQ newfile111 FILE13)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE12 NIL) 
(PROGN 
  (SETQ newfile111 FILE12)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE11 NIL) 
(PROGN 
  (SETQ newfile111 FILE11)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE10 NIL) 
(PROGN 
  (SETQ newfile111 FILE10)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE09 NIL) 
(PROGN 
  (SETQ newfile111 FILE09)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE08 NIL) 
(PROGN 
  (SETQ newfile111 FILE08)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
 
(IF (/= FILE07 NIL) 
(PROGN 
  (SETQ newfile111 FILE07)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE06 NIL) 
(PROGN 
  (SETQ newfile111 FILE06)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE05 NIL) 
(PROGN 
  (SETQ newfile111 FILE05)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE04 NIL) 
(PROGN 
  (SETQ newfile111 FILE04)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE03 NIL) 
(PROGN 
  (SETQ newfile111 FILE03)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE02 NIL) 
(PROGN 
  (SETQ newfile111 FILE02)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE01 NIL) 
(PROGN 
  (SETQ newfile111 FILE01)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(IF (/= FILE00 NIL) 
(PROGN 
  (SETQ newfile111 FILE00)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))

(IF (/= FILE NIL) 
(PROGN 
  (SETQ newfile111 FILE)
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
  (QUIT)))
  
(SETQ DIALOG_FILE (getfiled "AB DRAWINGS" newfile111 "DWG" 4))
;(SETQ DIALOG_FILE (STRCAT "z:\\AB\\xxx\\"  DIALOG_FILE))
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" DIALOG_FILE "\"")) 

);END OF FUNCTION EAB
    Reply With Quote Reply With Quote
  2. 2014-02-12, 11:11 PM #2
    marko_ribar
    marko_ribar is offline
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    2

    Default Re: Help with Code loop

    Hi, I've changed variable names according to my (while) looping, but the action of routine is the same... Try it, not tested though...

    Code:
    (defun c:EAB ( / *error* newfile111 k FILE DIALOG_FILE )

  (defun *error* ( msg / k )
    (setq k 16)
    (while (> (setq k (1- k)) -1)
      (set (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "A")) nil)
      (set (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "P")) nil)
    )
    (if msg (prompt msg))
    (princ)
  )

  (setq newfile111 (getstring "\nFile name to open in z:\\AB\\xxx\\AB\\ : "))
  (setq newfile111 (strcat "z:\\AB\\xxx\\AB\\" newfile111))

  (setvar 'FILEDIA 0)

  (setq k 16)
  (while (> (setq k (1- k)) -1)
    (set (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "A")) (findfile (strcat newfile111 "A" "." (if (> k 9) (itoa k) (strcat "0" (itoa k))) ".DWG")))
    (set (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "P")) (findfile (strcat newfile111 "P" "." (if (> k 9) (itoa k) (strcat "0" (itoa k))) ".DWG")))
  )
  (setq FILE (findfile (strcat newfile111 "" ".DWG")))

  (setq k 16)
  (while (> (setq k (1- k)) -1)
    (if (/= (eval (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "A"))) nil)
      (progn
        (setq newfile111 (eval (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "A"))))
        (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
        (quit)
      )
    )
    (if (/= (eval (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "P"))) nil)
      (progn
        (setq newfile111 (eval (read (strcat "FILE" (if (> k 9) (itoa k) (strcat "0" (itoa k))) "P"))))
        (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
        (quit)
      )
    )
  )

  (if (/= FILE nil) 
    (progn 
      (setq newfile111 FILE)
      (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
      (quit)
    )
  )
    
  (setq DIALOG_FILE (getfiled "AB DRAWINGS" newfile111 "DWG" 4))
  (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" DIALOG_FILE "\"")) 

  (princ)
);END OF FUNCTION EAB
    HTH, M.R.
    Reply With Quote Reply With Quote
  3. 2014-02-13, 01:54 PM #3
    GHarvey
    GHarvey is offline
    100 Club
    Join Date
    2000-11
    Location
    Ontario, Canada
    Posts
    116
    Login to Give a bone
    2

    Default Re: Help with Code loop

    A (very slightly) different approach. No error handling, and untested.

    Code:
    (defun c:foo ( / AP CTR DOCUMENTS NEWDOC NEWFILE NEWFILE111)
  (setq documents (vlax-get-property (vlax-get-acad-object) 'documents)
	newfile (strcat "z:\\AB\\xxx\\AB" (getstring "\nFile name to open in z:\\AB\\xxx\\AB"))
	ap (list "A" "P")
	ctr 31
	); setq
  (while (and (not (minusp ctr))
	      (null (setq newfile111 (findfile (strcat newfile (nth (rem ctr 2) ap) "." (itoa (/ ctr 2)) ".dwg"))))
	      ); and
    (setq ctr (1- ctr))
    ); while
  (if newfile111
    (progn
      (setq newdoc (vlax-invoke documents 'open newfile111))
      (vlax-invoke newdoc 'activate)
      ); progn
    (prompt "\nCannot find file. ")
    ); if
  ); setq
    Last edited by GHarvey; 2014-02-13 at 02:06 PM. Reason: Noticed some errors in code
    Reply With Quote Reply With Quote
  4. 2014-02-13, 01:58 PM #4
    GHarvey
    GHarvey is offline
    100 Club
    Join Date
    2000-11
    Location
    Ontario, Canada
    Posts
    116
    Login to Give a bone
    0

    Default Re: Help with Code loop

    Sorry, just noticed a few problems with the code above. Will correct shortly...

    Edit: Alright, that should do it... I hope.
    Last edited by GHarvey; 2014-02-13 at 02:07 PM.
    Reply With Quote Reply With Quote
  5. 2014-02-15, 09:52 PM #5
    lblakely391485
    lblakely391485 is offline
    Member
    Join Date
    2012-07
    Location
    Chattanooga
    Posts
    9
    Login to Give a bone
    0

    Default Re: Help with Code loop

    Thanks, guys.
    Reply With Quote Reply With Quote
  6. 2014-04-08, 09:49 PM #6
    lblakely391485
    lblakely391485 is offline
    Member
    Join Date
    2012-07
    Location
    Chattanooga
    Posts
    9
    Login to Give a bone
    0

    Default Re: Help with Code loop

    Thanks again for your help.
    I wound up with the following code.

    Code:
    (defun c:EDB (/ CTR DOCUMENTS NEWDOC NEWFILE NEWFILE111 num)
  (setq	documents (vlax-get-property (vlax-get-acad-object) 'documents)
	newfile	  (strcat "Z:\\DB\\XXX\\DB"(getstring "\nFile name to open in Z:\\DB\XXX\\DB"))
	ctr	  30
	) ; setq
  (while (not (minusp ctr))
    (if	(= 2 (strlen (itoa ctr)))
      (setq num (itoa ctr)) ; "Yes! Then"
      (setq num (strcat "0" (itoa ctr))) ; "No! Else"
      ) ;if
    (setq dwg (strcat newfile "P." num ".dwg"))
    (if	(findfile dwg)
      (setq newfile111 dwg)
      (setq dwg (strcat newfile "A." num ".dwg"))  
      )
    (if (findfile dwg)
	(setq newfile111 dwg)
	)
    (setq ctr (1- ctr))
    ) ; while
  (if newfile111
    (progn
      (command "vbastmt" (strcat "AcadApplication.Documents.Open " "\"" newfile111 "\""))
      (quit)
      ) ; progn
    (prompt "\nCannot find file. ")
    ) ; if
  )  ; setq
    Reply With Quote Reply With Quote
  7. 2014-04-09, 02:47 PM #7
    lblakely391485
    lblakely391485 is offline
    Member
    Join Date
    2012-07
    Location
    Chattanooga
    Posts
    9
    Login to Give a bone
    0

    Default Re: Help with Code loop

    Well, after further review....

    Code:
    (defun c:FDB (/  CTR DOCUMENTS NEWDOC NEWFILE NEWFILE111 num)
  (setq	documents (vlax-get-property (vlax-get-acad-object) 'documents)
	newfile	  (strcat "Z:\\DB\\XXX\\DB"(getstring "\nFile name to open in Z:\\DB\XXX\\DB"))
	ctr 30
	) ; setq
  (if (while (not (minusp ctr))
	(if (= 2 (strlen (itoa ctr)))
	  (setq num (itoa ctr)) ; "Yes! Then"
	  (setq num (strcat "0" (itoa ctr))) ; "No! Else"
	  ) ;if
	(setq dwg (strcat newfile "P." num ".dwg"))
	(if (findfile dwg)
	  (setq newfile111 dwg)
	  (setq dwg (strcat newfile "A." num ".dwg"))
	  )
	(if (findfile dwg)
	  (setq newfile111 dwg)
	  )
	(if newfile111
	  (progn (command "vbastmt" (strcat "AcadApplication.Documents.Open ""\"" newfile111 "\""))
		 (quit)
		 ) ; progn
	  ) ; if
	(setq ctr (1- ctr))
	) ; while
    (prompt "\nCannot find file. ")
    ) ; if
  )  ; setq
    Reply With Quote Reply With Quote
  8. 2014-04-09, 03:34 PM #8
    Opie
    Opie is offline
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,150
    Login to Give a bone
    0

    Default Re: Help with Code loop

    Does this do what you need it to do? Will there only ever be 15 numbers? Will there only be an "A" or "P" named files in the directory?

    Why not get a list of the files in the directory that match your filename prefix? You can quickly get that with the vl-directory-files function.
    Code:
    (defun GetAvailableFiles (directory prefix code extension / FileList)
  ; Returns a list of filenames found in the directory.

  ; Required variables
  ; directory is a string containing the directory path
  ; prefix is the filename prefix as supplied by the user
  ; code is a list of codes
  ; extension is the file extension and should be prefixed with a "."
  (foreach n code
    (setq FileList (append FileList
			   (vl-directory-files
			     directory
			     (strcat prefix code ".??" extension)
			   )
		   )
    )
  )
)
    You could then assign the returned value to a variable and then cycle through the list to open each file.
    Code:
    (defun c:FDB (/ directory prefix code extension AvailableFiles documents newdoc)
  (setq	directory      "Z:\\DB\\XXX\\DB"
	prefix	       (getstring
			 (strcat "\nFile name to open in <" directory ">: ")
		       )
	code	       '("A" "P")
	extension      ".dwg"
	AvailableFiles (GetAvailableFiles directory prefix code extension)
  )

  (if AvailableFiles
    (progn
      (setq documents
	     (vlax-get-property (vlax-get-acad-object) 'documents)
      )
      (foreach n AvailableFiles
	(setq newdoc
	       (vlax-invoke documents 'Open (strcat directory "\\" n))
	)
	(vlax-invoke newdoc 'Activate)
      )
      (vlax-release-object newdoc)
      (vlax-release-object documents)
    )
  )
)
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Similar Threads

  1. how do i loop this?
    By mgonzales.224492 in forum AutoLISP
    Replies: 2
    Last Post: 2009-07-31, 06:41 PM
  2. Insert vbscript code has not code
    By buzz in forum AMEP General
    Replies: 3
    Last Post: 2008-02-09, 03:08 AM
  3. Block Insert Array (Loop within a Loop)
    By wpeacock in forum VBA/COM Interop
    Replies: 2
    Last Post: 2005-06-14, 04:24 AM

Posting Permissions

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

Forum Rules