Jump to content

Lisp routines don't work in deeper folders


Tomislav

Recommended Posts

Hello everybody.

I don't know am I posting to the right place but maybe someone can help.

The problem is that my lisp routines won't work on files that are saved more than two levels of nested folders (C:/something/something/something/file.dwg) and I can't figure out why.I get the message that file is nil. I have win10 x64 and tried with few versions of CAD. Any suggestions?

Link to comment
Share on other sites

Well , without a lisp that's a tough one to answer ...

 

 

Standard pitfalls are correct use of escape characters \\ vs / and \" for " , spaces in folder paths. Use something like

 

 

 (if (setq fn (findfile your-dwg-name)) (open_fn_and_do_your_stuff) ;|else|;(princ "drawing not found"))

 

 

gr. Rlx

Link to comment
Share on other sites

I can put in one lisp but it's all of them using file manipulation, and they have worked before on my old system, and work in my office so I think it's not about them but maybe some cad or system settings.

I noticed something curious, when they are loaded as part of one big .vlx file with every drawing, cad writes"******** no system variable has been changed ***********" (or something like this)

Link to comment
Share on other sites

Like Rlx

 

(C:\\something\\something\\something\\file.dwg)

 

A different problem

(C:/something/something/something/file dwg1.dwg) 
It will fail at the file[b]space[/b]dwg1 the space in the name causes problems

 

Again like Rlx post the bit of code.

Link to comment
Share on other sites

(defun c:lp (/ f a numt doc_path txt decimals name loop)
 
 (defun *error* (msg)
   (if(or(= msg "quit / exit abort")
  (= msg "bad argument type: lentityp nil")
  (= msg "bad argument type: numberp: nil")
  )
     (princ "")
     (princ msg)
     )
   (close f)
   )


 (setvar "cmdecho" 0)
 (command "dimzin" 0)
 (setvar "cmdecho" 1)
 (setq txt "")
 (initget 0 "N W")
 (or
   (setq name
   (getkword
     "\nDo you wish to list coords with name or without [ <Name> / Without ] "))
   (setq name "N")
   )
 (initget 0 "0 1 2 3 4")
 (or
   (setq decimals(getkword"\nEnter number of decimals  [ 0/1/2/3/4 ] <3> : "))
   (setq decimals "3")
   )
 (setq decimals (atoi decimals))
 (setq doc_path(getvar 'DWGPREFIX))
 (setq doc_path (vl-string-translate "/" "\\" doc_path))
 (setq f (open (getfiled "Text File" doc_path "txt" 5) "a"))
 (setq loop T)
 (while loop
   (if (= name "N")
     (progn
(if(wcmatch
     (cdr
       (assoc 0
	      (setq numt (ENTGET (CAR (ENTSEL "\nSelect point number: "))))
	      )
       )
     "ATTRIB,MTEXT,TEXT"
     )	  
  (progn
    (setq a (getpoint "\nSelect point: "))
    (if(=(cdr(assoc 0 numt))"MTEXT")
      (progn
	(GetTextFromMText numt)
	(princ txt f)
	(princ"\n")
	
	)
      (princ (cdr (assoc 1 numt)) f)
      )
    (princ "," f)
    (princ (rtos (car a) 2 decimals) f)
    (princ "," f)
    (princ (rtos (cadr a) 2 decimals) f)
    (princ "," f)
    (princ (rtos (caddr a) 2 decimals) f)
    (princ "," f)
    (princ "\n" f)
    )
  (progn
    (close f)
    (quit)
    )
  )
)
     )
   (if (= name "W")
     (progn
(setq a (getpoint "\nSelect point: "))
(princ (rtos (car a) 2 decimals) f)
(princ "," f)
(princ (rtos (cadr a) 2 decimals) f)
(princ "," f)
(princ (rtos (caddr a) 2 decimals) f)
(princ "," f)
(princ "\n" f)
)
     )
   )
 (close f)
 (quit)
 )

(princ
 "\nList points...by TOMISLAV VARGEK...Osijek,Croatia...\n...Type LP to initiate..."
)






(defun GetTextFromMText (numt / posto_pos ima)
 (setq txt (cdr (assoc 1 numt)))			 	;vadim tekst
 (setq txt(vl-string-right-trim " } " txt))		       ;oduzimam desnu } i razmak
 (setq txt(substr txt (+(vl-string-search ";" txt)2)))        ;oduzimam sve do prvog ;
 (if (=(vl-string-search ";" txt (-(strlen txt)1))(-(strlen txt)1)); ako je ; na kraju
   (setq txt(vl-string-right-trim "; " txt))			;oduzimam desno sve do ;
   )
 (if (=(vl-string-search "{" txt)0)	;ako je ostala na prvom mjestu { vadim sve od
   (setq txt(substr txt(vl-string-search ";" txt))); prvog ; do kraja
   )
 (if (>(vl-string-search "{" txt)0)	                    ;ako je ostala negdje { vadim sve od nje do ;
   (setq txt(strcat(substr txt 1 (vl-string-search "{" txt)); i spajam s ostalim
       (substr txt(+(vl-string-search ";" txt)2))
	    )
  )
   )
 (setq txt(vl-string-subst "" "\\S" txt))
 (setq ima T)
 (while ima
   (if (>(setq posto_pos(vl-string-search "%%" txt))0)
     (setq txt(strcat(substr txt 1 posto_pos)(substr txt (+ posto_pos 4))))
     (setq ima nil)
     )
   )
 )

Link to comment
Share on other sites

I can put in one lisp but it's all of them using file manipulation, and they have worked before on my old system, and work in my office so I think it's not about them but maybe some cad or system settings.

I noticed something curious, when they are loaded as part of one big .vlx file with every drawing, cad writes"******** no system variable has been changed ***********" (or something like this)

 

 

There may be differences in cad versions , like command vs command-s and on some systems there may be a reactor at work in the background?

Link to comment
Share on other sites

I've tried a couple of CAD versions in which they work at my office...I don't know what is this reactor

 

 

reactors are like little gremlins that work in the background and can react on certain commands. But I see you have added some code. Maybe the answer lies in the code , I or Bigal will have a look. First have a meeting shortly...

Link to comment
Share on other sites

well I can't find what the path would matter for your app to function so I can't reproduce your problem. Did some rlx-pimping to test it on my own system. Just want to say that I strongly advise not to use (quit) , its like putting out the light with a brick or hitting your mother-in-law with a truck when a baseball bat is sufficient enough...

 

 

(defun c:lp  (/ f a inp numt doc_path txt decimals name)
 
 (defun *error*  (msg)
   (if (or (= msg "quit / exit abort") (= msg "bad argument type: lentityp nil") (= msg "bad argument type: numberp: nil"))
     (princ "") (princ msg)) (if f (close f)))
 (setvar "cmdecho" 0) (command "dimzin" 0)(setvar "cmdecho" 1) (setq txt "")
 (initget 0 "N W")
 (or (setq name (getkword "\nDo you wish to list coords with name or without [ <Name> / Without ] "))(setq name "N"))
 (initget 0 "0 1 2 3 4")
 (or (setq decimals (getkword "\nEnter number of decimals  [ 0/1/2/3/4 ] <3> : "))(setq decimals "3"))
 (setq decimals (atoi decimals) doc_path (vl-string-translate "/" "\\" (getvar 'DWGPREFIX)))
 (if (setq f (open (getfiled "Text File" doc_path "txt" 5) "a"))
   (while (setq inp (entsel "\nSelect point number: "))
     (cond
((and (= name "N") (member (cdr (assoc 0 (setq numt (entget (car inp))))) '("ATTRIB" "MTEXT" "TEXT")))
 (setq a (getpoint "\nSelect point: "))
        ;(if (= (cdr (assoc 0 numt)) "MTEXT") (progn (GetTextFromMText numt)(princ txt f)(princ "\n"))(princ (cdr (assoc 1 numt)) f))
 (if (= (cdr (assoc 0 numt)) "MTEXT")
   (princ (LM:UnFormat (cdr (assoc 1 numt)) nil) f) (princ (cdr (assoc 1 numt)) f))
 (mapcar
   '(lambda (x) (princ x f))
   (list "," (rtos (car a) 2 decimals) "," (rtos (cadr a) 2 decimals) "," (rtos (caddr a) 2 decimals) "\n")
 )
        ;(princ "," f) (princ (rtos (car a) 2 decimals) f)  (princ "," f) (princ (rtos (cadr a) 2 decimals) f)
        ;(princ "," f) (princ (rtos (caddr a) 2 decimals) f) (princ "," f)(princ "\n" f)
)
       ((= name "W")
        (setq a (getpoint "\nSelect point: "))
        (princ (rtos (car a) 2 decimals) f)(princ "," f)(princ (rtos (cadr a) 2 decimals) f)(princ "," f)
        (princ (rtos (caddr a) 2 decimals) f)(princ "," f)(princ "\n" f))
     )
   )
 )
 (if f (close f))
)
(princ "\nList points...by TOMISLAV VARGEK...Osijek,Croatia...\n...Type LP to initiate...")
(defun GetTextFromMText  (numt / posto_pos ima)
 (setq txt (cdr (assoc 1 numt))) ;vadim tekst
 (setq txt (vl-string-right-trim " } " txt))
    ;oduzimam desnu } i razmak
 (setq txt (substr txt (+ (vl-string-search ";" txt) 2)))
    ;oduzimam sve do prvog ;
 (if (= (vl-string-search ";" txt (- (strlen txt) 1))
 (- (strlen txt) 1)
 )    ; ako je ; na kraju
   (setq txt (vl-string-right-trim "; " txt)) ;oduzimam desno sve do ;
   )
 (if (= (vl-string-search "{" txt) 0) ;ako je ostala na prvom mjestu { vadim sve od
   (setq txt (substr txt (vl-string-search ";" txt)))
    ; prvog ; do kraja
   )
 (if (> (vl-string-search "{" txt) 0) ;ako je ostala negdje { vadim sve od nje do ;
   (setq txt (strcat (substr txt 1 (vl-string-search "{" txt))
    ; i spajam s ostalim
       (substr txt (+ (vl-string-search ";" txt) 2))
       )
  )
   )
 (setq txt (vl-string-subst "" "[url="file://\\S"]\\S[/url]" txt))
 (setq ima T)
 (while ima
   (if (> (setq posto_pos (vl-string-search "%%" txt)) 0)
     (setq txt (strcat (substr txt 1 posto_pos)(substr txt (+ posto_pos 4))))
     (setq ima nil)
     )
   )
 )
;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;
(defun LM:UnFormat ( str mtx / _replace rx )
 (defun _replace ( new old str )(vlax-put-property rx 'pattern old)(vlax-invoke rx 'replace str new))
 (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
   (progn
     (setq str
     (vl-catch-all-apply
       (function
  (lambda ( )
    (vlax-put-property rx 'global actrue)(vlax-put-property rx 'multiline actrue)
    (vlax-put-property rx 'ignorecase acfalse)
    (foreach pair '( ("\032"    . "\\\\\\\\")
                                   (" "       . "\\\\P|\\n|\\t")
                                   ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                   ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                   ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                   ("$1"      . "[\\\\]({)|{"))
      (setq str (_replace (car pair) (cdr pair) str)))
    (if mtx
      (_replace "\\\\" "\032" (_replace "[url="file://\\$1$2$3"]\\$1$2$3[/url]" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
      (_replace "\\"   "\032" str))))))  (vlax-release-object rx)(if (null (vl-catch-all-error-p str)) str)
   )
 )
)

 

 

gr. Rlx

Link to comment
Share on other sites

well I can't find what the path would matter for your app to function so I can't reproduce your problem. Did some rlx-pimping to test it on my own system. Just want to say that I strongly advise not to use (quit) , its like putting out the light with a brick or hitting your mother-in-law with a truck when a baseball bat is sufficient enough...

gr. Rlx

 

good one :):)

 

...and a nice mtext function..

Link to comment
Share on other sites

... Just want to say that I strongly advise not to use (quit) , its like putting out the light with a brick or hitting your mother-in-law with a truck when a baseball bat is sufficient enough...

.....

gr. Rlx

LOL .. that's hilarious. :)

Link to comment
Share on other sites

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...