AutoLISP program giving inconsistent results - csv

Software: AutoCAD 2012 (Japanese language)
System: MS Windows 7 (Japanese language)
The Situation
I have made a .LSP file which defines a new function "C:MAKEATABLE".
It asks the user to select a .CSV file and then it imports its data to the drawing file opened in AutoCAD. The .CSV file has two columns:
Serial number (integer)
Data (real number)
The last line of the .CSV file is "EOF".
The data imported should be such that each text entity is independent of the other, except for the fact that they are arranged in a tabular manner from the insertion point specified by the user.
Now, my problem is that whenever I load that .LSP file and call my function, the result is not always the same.
Sometimes the values appear perfectly in the desired manner; but many times the values appear jumbled up. There are three types of ways in which the values appear jumbled up.
I tried restarting the application as well as the PC, but to no
avail.
I have declared all the variables to be local, so that they are not
interfered with.
Here is the complete code: Pastebin link also available
(defun c:makeatable ( / filename csvfile startpt data rdline digits lineno currentpt datapt datarelpt baserelpt indexbasept temp2 temp3 temp4 temp5 wide1 wide2 rowheight txtheight tempvar tmps)
(setq filename (getfiled "Data File" "C:/Temp/drawings/" "csv" 128)) ;prompt user to open the file containing the data
(setq csvfile (open filename "r")) ;open the file to read its contents
(setq startpt (getpoint "\n Table insertion point: ")) ;prompt user to choose the insertion point
;------------;prompt user to input the parameters; if nil, default value is set;--------------------------;
;
;** This code is useful when default values are needed, so that the user doesn't have to enter them. **;
;** If the values appear jumbled, kindly run the program again with appropriate values. **;
;** **;
(initget (+ 2 4))
(if (not(setq txtheight (getreal "\n Enter Text height: ")))
(setq txtheight 4.0)
)
(princ)
(initget (+ 2 4))
(if (not(setq wide1 (getreal "\n Enter first column width: ")))
(setq wide1 15.0)
)
(princ)
(initget (+ 2 4))
(if (not(setq wide2 (getreal "\n Enter second column width: ")))
(setq wide2 30.0)
)
(princ)
(initget (+ 2 4))
(if (not(setq rowheight (getreal "\n Enter Row height: ")))
(setq rowheight 7.0)
)
(princ)
;----------------------------------------------------------------------------------------------------------;
(setq lineno 1) ;this var stores the line at which the program is currently at
(setq digits 0) ;this var stores the (number of digits - 1) of the index
(setq currentpt startpt) ;initialize currentpt
;-------*------temporary variables for the arrangement of the data------*-------;
(setq temp2 (/ (+ rowheight txtheight) 2))
(setq temp3 (+ wide1 (* txtheight 2)))
(setq temp4 (+ wide1 (/ wide2 5)))
(setq temp5 (- wide1 (/ wide1 20)))
(setq tempvar (list 0 (* -1 rowheight) 0))
;-------------------------------------------------------------------------------;
(setq datarelpt (list temp4 temp2 0)) ;these are relative points;
(setq baserelpt (list temp5 temp2 0))
;------------------------------;while loop;-------------------------------------;
(while (/= rdline "EOF")
(cond ((> lineno 9) ;check the number of ;
(setq digits 1) ;digits in the index ;
)
((> lineno 99)
(setq digits 2)
)
);end cond
(setq datapt (mapcar '+ ;these lines ;
currentpt ;set the coordinates ;
datarelpt ;for the data ;
) ; ;
)
(setq indexbasept (mapcar '+ ;these lines ;
currentpt ;set the coordinates ;
baserelpt ;for the index ;
) ; ;
)
(setq rdline (read-line csvfile)) ;read a line from the CSV file
(setq data (substr rdline (+ 3 digits)));extract the data from the read line
(setq tmp (command "STYLE" "MONO" "MONOTXT" "" "" "" "" "" "")) ;makes the text monospace
;-----------------------------printing the values-----------------------;
(command "text" datapt txtheight 0 data) ;write the data
(command "text" "_j" "_r" indexbasept txtheight 0 lineno) ;write the index number
;-------------------------------------------------------------------;
(setq lineno (1+ lineno)) ;increment line number
(setq currentpt (mapcar '+ ;increment the ;
currentpt ;current point ;
tempvar ;coordinates ;
) ; ;
)
)
;------------------------------;while loop ends;------------------------------------;
(entdel (entlast)) ;to remove the extra index number printed at the end
(close csvfile) ;close the opened file
(princ) ;clean exit
)
I even checked the points at which the text are being inserted [using (princ datapt) and (princ indexbasept)], and found them to be alright. However, when AutoCAD creates these text objects on the screen, they occupy the same position and get jumbled up.
Kindly tell me where i might be going wrong and what should I do now.

My first thought is that you need to turn off osnaps before running your command.
(setq orig-osm (getvar "osmode"))
(command "osmode" 0)
... the rest of your command ...
(command "osmode" orig-osm)
Depending on your constraints I think you could also generate the table columns as mtext (multi-line text) and explode them each after creation to create separate text objects. You can use (ssget "L") to operate on the last element added to the database.

Related

Call a function while in a loop (Common Lisp)

I am making a console Lisp survival game and I am trying to add a function where until a = b, show "." every second. Then, when a = b, set a "hurt" variable to true, and if/when that variable is true, subtract "health" by 1 until the "use-medkit" function is invoked by the user and the "hurt" variable is set false and you exit both loops.
The problem I am having is when I am prompted to use the "use-medkit" function and I type it in, it doesn't evaluate anything that I input and keeps subtracting 1 from "health". How can I call a user-inputted function while a loop is running?
Here is my code:
(setq a (random 11)) ; Random from 0 - 10
(setq b (random 11)) ; ^^^^^^^^^^^^^^^^^^
(setq hurt 0)
(setq repair 0)
(setq health 999)
(defun use-medkit ()
(setq repair 1))
(defun get-hurt ()
(loop
(progn
(setq a (random 11))
(setq b (random 11))
(progn
(princ ".")
(sleep 1)))
(if (eq a b) (progn
(setq hurt 1)
(when (eq hurt 1) (progn
(format t "~%You are hurt!~%You will lose 1 hp every 10 seconds~%~%Type use-medkit to stop the bleeding~%")
(loop
(progn
(- 1 health)
(sleep 10))
;(format t "health: ~A~%" health)
(when (eq repair 1) (progn
(return "You stopped the bleeding") (setq hurt 0) (setq repair 0))))))))))
So a program can’t do two things at once. In particular if you’re busy printing dots, sleeping and subtracting 1 from 999 then you won’t pause to see if there’s another command coming.
Unfortunately solving this problem is hard. The nicest solution in a terminal would probably use something like ncurses. Additionally there is no standard way to control input buffering. In lieu of that, here is a simple way you can do a bit of concurrency and some prompts. You might want to use a proper async library instead.
(defun maybe-read (input-stream recording-stream)
(when (listen input-stream)
(let ((char (read-char input-stream)))
(if (char= char #\Newline)
t
(progn (write-char char recording-stream) (maybe-read))))))
(defun make-partial-reader (input-stream)
(list input-stream (make-string-output-stream)))
(defun partial-read (reader)
(when (apply #'maybe-read reader)
(get-output-stream-string (second reader))))
(defun how-long-until (time)
(let ((gap
(/ (- time (get-internal-run-time)) internal-time-units-per-second)))
(cond ((< gap 0) (values 0 :late))
((<= gap 0.001) (values 0 :now))
(T (values (- gap 0.001) :soon)))))
(defun sleep-until (time)
(multiple-value-bind (span type)
(how-long-until time)
(when (> span 60) (warn “long wait!”)
(case type
(:late nil)
(:now t)
(:soon
(sleep span)
(unless (sleep-until time) (warn “poor timekeeping”))
t))))
(defmacro with-prompt-and-scheduler ((schedule) (line &optional (input *standard-input*)) &body handle-line-input)
(let ((reader (gensym)) (insched (gensym)))
`(let ((,reader (make-partial-reader ,input) (,insched)))
(flet ((,schedule (in fun &aux (at (+ (get-internal-run-time) (* in internal-time-units-per-second))))
(if (null ,insched) (push (cons at fun) schedule)
(loop for s on ,insched
for ((at2) . y) = s
if (< at at2)
do (psetf (car s) (cons at fun)
(cdr s) (cons (car s) (cdr s)))
(finish-loop)
unless y do (setf (cdr s) (acons at fun nil)) (finish-loop)))))
(loop
(if ,insched
(let ((,insched (pop ,insched)))
(when (sleep-until (car ,insched))
(let ((,line (partial-read ,reader)))
(when ,line ,#handle-line-input)))
(funcall (cdr ,insched)))
(let ((,line (concatenate 'string (get-output-stream-string (second ,reader)) (read-line (first ,reader)))))
,#handle-line))))))))
And then you could use it like:
(let ((count 0))
(with-prompt-and-scheduler (schedule) (line)
(let ((n (read-from-string line)))
(when (realp n)
(schedule n (let ((x (incf count))) (lambda () (format t "Ding ~a ~a~%" x count) (finish-output))))))))
And after running that input 10, then on the next line 5. If you do that quickly you’ll get:
Ding 2 2
Ding 1 2
With the first line appearing after 5 seconds and the second after 10. If you are slow you should get:
Ding 1 1
Ding 2 2
With the first line coming 10 seconds after you enter 10 and the second line coming 5 seconds after you enter 5.
Hopefully this can give you an idea of how to make a program seem to do two things at once.

Autolisp: "While" loop with .dxf output

I'm writing a lisp app to create 2D patterns for a CNC cutter. I have an Excel program that outputs 3-10 short lisp subroutines for individual pieces associated with each pattern, and I can get any number of these subs to load inside my "while" loop and draw the piece, but none of the methods I can get working to create .dxf files from the drawings generated by one of the pattern subs will let me resume the loop. If I pull out the dxfout and erase steps and just let them all draw on top of one another, it works like a charm.
(defun c:CreateDXF (/ owd ofd sdate)
(setq owd (acet-file-cwd))
(acet-file-chdir "P:\\")
(setq ofd (getvar "filedia"))
(setvar "filedia" 0)
(setq sdate (getstring "\nEnter the order start date in YYYYMMDD format: "))
(setq fpath (strcat "P:\\LSP\\" sdate))
(setq wopath (acet-ui-pickdir "Select Work Order Folder" fpath))
(setq flist (vl-directory-files wopath "*.lsp" 1))
(while (> (length flist) 0)
(setq fname (car flist))
(setq wfile (strcat wopath "\\" fname))
(vl-file-rename wfile "P:\\LSP\\temp.lsp")
(load "P:\\LSP\\temp.lsp")
(vl-file-rename "P:\\LSP\\temp.lsp" wfile)
(setq savepath (strcat "P:\\DXF\\" sdate))
(setq savename (strcat (vl-filename-base wfile) ".dxf"))
(setq patt (ssget "x"))
(command "_.dxfout" savepath "_Objects" patt "" "_Version" "2013" "16" "" "")
(command "erase" "all" "")
(setq flist (cdr flist))
);while
(acet-file-chdir owd)
(setvar "filedia" ofd)
(alert "Done")
(princ)
);defun
Running this as written hangs up at the first dxfout step. I can reset the program through the lisp editor, and then file appears in the output directory and the dxf comes up in a new tab, but obviously that exits the loop without processing the rest of the pieces.
Am I missing something obvious? Would it be better to draw all of the pattern pieces in the same drawing as named entities and then batch out each entity at the end?
It might be easier to approach this from outside of AutoCAD. Maybe using a PowerShell script to fetch the .dwg files list, open AutoCAD, then loop through the drawing list, export the .dxf, close the .dwg and do the next, then close AutoCAD.

ELISP: Function to prompt user for number and ask user for that number of strings and insert then into list

I'd like to create an ELISP function that will prompt a user for a number, n, then continually prompt the user n times for strings. Ideally, I'd like all these string put into a list. Here's what I have so far. Obviously, what I have doesn't work, but it might help clarify the type of thing I want to do.
(defun prompt-user-n-times (n)
"Prompt user n time for strings and append strings to list"
(interactive "nHow many strings: ")
(while (> n 0)
(append newlist (interactive "sGive me input: "))
(setq n (- n 1))
))
Thanks.
just define a binding for your new list:
(defun prompt-user-n-times (n)
"Prompt user n time for strings and append strings to list"
(interactive "nHow many strings: ")
(let ((newlist ()))
(while (> n 0)
(setq newlist (append newlist (list (read-string "Give me input: "))))
(setq n (- n 1)))
newlist))
Several remark: interactive is only at beginning of a defun, in the
function, one use other prompt function, like the simple
read-string. append ask for two list, so the string returned
by read-string should be put into a list by the list function

Isearch return t if found for loop function in Emacs Lisp

How to write a function where whenever a variable is found, it returns t (in order to allow a loop):
(setq x 1)
(while ("backward search for regexp "%x" equals true") ;where x is variable
(setq x (+ x 1))
(insert (concat "%" (int-to-string x)))
)
Example: If %1 (x=1) is found, it will add 1 to x. If %2 (x=2) is found, it will add 1 to x.
Let's say %3 is not found in a backward search, the while loop stops and "%" + "3" is inserted (%3).
I just don't understand the how to return true on a backward-search.
search-backward takes an optional third argument which, when non-nil, tells it to return nil in case the search was unsuccessful:
(setq x 1)
(while (search-backward (format "%%%d" x) nil t)
(setq x (1+ x)))
(insert (format "%%%d" x))
Now, if I try to understand what you really want to do (something like inserting at point the first %d string which doesn't appear before), then you might want to wrap the search inside a save-excursion form to avoid moving the point:
(setq x 1)
(while (save-excursion (search-backward (format "%%%d" x) nil t))
(setq x (1+ x)))
(insert (format "%%%d" x))
With help from Francesco
(defun Navi-insert-question ()
(interactive)
(setq x 1)
(while (save-excursion
(search-backward (concat comment-start " Question: " (int-to-string x)) nil t))
(setq x (+ 1 x)))
(insert (concat comment-start " Question: " (int-to-string x))))
It now results in being able to insert in R, for instance: "# Question: 1", when it exists above in the buffer it will insert "# Question: 2".

How to loop while following-char equals string?

I am writing a function to uncomment regardless of mode. I want to delete all comment characters at the beginning of a line.
How do I make the snippet below loop until the following character is not equal to comment-start? (so basically have this "if" go on and on and on until following-char is not equal to comment-start anymore)
(if (string= (byte-to-string (following-char)) comment-start)
(progn (delete-forward-char 1)
(when (string= (byte-to-string (following-char)) " ")
(delete-forward-char 1))))
A while loop was easier than I thought:
(defun uncomment-mode-specific ()
"Uncomment region OR uncomment beginning of line comment OR uncomment end"
(interactive)
(if (region-active-p)
(uncomment-region (region-beginning) (region-end))
(back-to-indentation))
(setq scvar 0)
(setq scskipvar 0)
(while (= scvar 0)
(if (string= (byte-to-string (following-char)) comment-start)
(progn (delete-forward-char 1)
(when (string= (byte-to-string (following-char)) " ")
(delete-forward-char 1))
(setq scskipvar 1))
(setq scvar 1)))
(if (= scskipvar 0)
(progn (search-forward comment-start nil t)
(left-char 1)
(kill-line))
)
)