AutoLISP Drawing Insert Scale from 1 point to another - autolisp

I have a routine that is designed to created an duct elbow in AutoCAD and then insert a turning vane.
I have the program working almost perfectly, it's just that when I go to insert the block I have it set so that the scale of the block is the cross-sectional distance from point 2 to point 5 (this is the inside corner and outside corner of the elbow respectively) and the inserted block is distorted horribly.
I don't know if there is a way to avoid this or not.
; Garrett Ford 6/23/17
; The purpose of this program is to allow the user to enter a few
; dimensions and then insert and elbow with a turning vane
(defun C:bow(/ oldsnap oldlayer oldblip flag iw fw tt rot ip ang bend p1 p2 p3 p4 p5 p6 ss)
;***********************************************************************
; Save System Variables
(setq oldsnap (getvar "osmode"))
(setq oldlayer (getvar "clayer"))
(setq oldblip (getvar "blipmode"))
;***********************************************************************
;Change Settings & User Input
(setvar "osmode" 35)
(setvar "blipmode" 0)
(setq flag (tblsearch "Layer" "LP-DUCT")) ; checks for LP-DUCT
(if flag
(setvar "clayer" "LP-DUCT") ; changes layer to LP-DUCT
(alert ("No LP-DUCT Layer!")) ; if layer doesn't exist fuction terminates
)
(setq iw (getdist "\nWhat is the Initial Width? : "))
(setq fw (getdist "\nWhat is the Final Width? : "))
(setq tt (getdist "\nWhat is the Throat Length: "))
;(setq rot (getangle "\nWhat is the Angle of Rotation? : "))
(setq ip (getpoint "\nSelect an Insertion Point: "))
(setq ang (getangle ip "\nWhat is the Initial Throat direction from the Insertion point?: "))
(initget 1 "Left Right")
(setq bend (if (= (getkword "\nBend direction [Left/Right]: ") "Right") - +))
;***********************************************************************
; Polar Calculations
(setq p1 (polar ip (bend ang (/ pi 2)) (/ iw 2)))
(setq p2 (polar p1 ang tt)) ; Inside Corner
(setq p3 (polar p2 (bend ang (/ pi 2)) tt))
(setq p4 (polar p3 ang fw))
(setq p5 (polar p4 (bend ang (- (/ pi 2))) (+ tt iw))) ; Outside Corner
(setq p6 (polar p5 (+ ang pi) (+ tt fw)))
;***********************************************************************
; Line & Insert Commands
;(setq ss (ssadd))
(setvar "osmode" 0)
(command "_.pline" ip p1 p2 p3 p4 p5 p6 "_close")
;(ssadd (entlast) ss)
(setvar "osmode" 7079)
(command "_.insert" "tvain" p2 (distance p2 p5) (+ ang (/ pi 2)))
;(ssadd (entlast) ss)
;(command "rotate" ss "rot" ip pause)
(setvar "osmode" oldsnap)
(setvar "clayer" oldlayer)
(setvar "blipmode" oldblip)
) ; End Defun
;************************************************************************
;Converts the Degrees into Radians
(defun dtr (ang) ;define degrees to radians function
(* pi (/ ang 180.0))
;divide the angle by 180 then
;multiply the result by the constant PI
) ;end of function
;************************************************************************

There are a few issues with your code:
(alert ("No LP-DUCT Layer!")) will error.
This should instead be:(alert "No LP-DUCT Layer!")
You should test whether each of your getXXX calls (e.g. getpoint, getdist etc.) return a non-nil value before proceeding. Since in AutoLISP anything which is non-nil is considered a True result, this can be easily achieved using a combination of if and and, for example:
(if
(and
(setq iw (getdist "\nWhat is the Initial Width? : "))
(setq fw (getdist "\nWhat is the Final Width? : "))
(setq tt (getdist "\nWhat is the Throat Length: "))
(setq ip (getpoint "\nSelect an Insertion Point: "))
(setq ang (getangle ip "\nWhat is the Initial Throat direction from the Insertion point?: "))
...
)
(progn
;; Do your thing
)
)
Since AutoLISP supports short-circuit evaluation, the and function will cease evaluation of the arguments as soon as an expression returns nil. Hence, if the user does not provide a value for the Initial Width, the and expression will not be validated and they will not be prompted to specify the Final Width.
I would suggest using the command-line version of the INSERT command by prefixing the command with a hyphen (i.e. -INSERT).
I would also suggest explicitly specifying the scale & rotation using the keywords provided by this command, e.g.:
(command "_.-insert" "tvain" "_S" (distance p2 p5) "_R" (angtos (+ ang (/ pi 2))) "_non" p2)
The angtos function is required in this case as the -INSERT command (and indeed any command evaluated using the command function) uses the angular units set within the drawing, as opposed to radians.
The dtr function defined in your code is not being evaluated and so may be omitted.
Rather than setting the OSMODE system variable to 0, you may want to use the following expression to set bit 16384:
(setvar 'osmode (logior 16384 (getvar 'osmode)))
This is the equivalent of the user pressing F3 to disable Object Snaps as opposed to setting OSMODE to 0, which is the equivalent to the user unchecking all of the Object Snap modes in the dialog.
This has the advantage that if your code errors for any reason (including if the user presses Esc during program execution), Object Snap will merely be disabled and may be re-enabled using F3, rather than wiping the user's Object Snap settings entirely.
Alternatively, you can avoid changing the OSMODE system variable altogether and instead prefix your point inputs with the "_non" snap modifier (meaning 'none'), which causes AutoCAD to ignore all active snap modes for the next point input, e.g.:
(command "_.pline" "_non" ip "_non" p1 ... etc ... "_close")
Or, as another option, you could use a locally defined error handler which would reset the OSMODE system variable (and all other modified system variables) following an error in the code. I describe how to do this in my tutorial on Error Handling.

Related

Syntax Error Message in IntelliJ Cursive Clojure

I'm learning Clojure. I wrote a first-attempt at calculating a Fibonacci number. Here's my code and the subsequent error message.
I have NO CLUE what to correct. My question is: WHAT is the error message trying to say?
(defn fibon
(fn [n]
(loop [loops n acc 1N acc2 0N]
(if (<= loops 0)
acc ;; Return the summed F number.
(recur (dec loops) (+ acc acc2) acc)))))
Syntax error macroexpanding clojure.core/defn at
(form-init1248982153229513778.clj:1:1). fn - failed: vector? at:
[:fn-tail :arity-n :bodies :params] spec:
:clojure.core.specs.alpha/param-list (fn [n] (loop [loops n acc 1N
acc2 0N] (if (<= loops 0) acc (recur (dec loops) (+ acc acc2) acc)))) failed: vector? at: [:fn-tail :arity-1 :params] spec: :clojure.core.specs.alpha/param-list
In general, could someone please point me to some documentation on Clojure in Cursive so I can decipher these error messages myself, if there is such a beast. Thank you.
The error message you see is a clojure.spec error. It is telling you that your code violates the specification of defn.
The error message is cryptic but if you unpack the error message you can see that the param-list clojure.spec failed because (fn [n] (loop ... is not a vector?
This is trying to tell you that defn expected to see a vector after fibon, not (fn [n] (loop ... It is not the most intuitive error message.
There is the clojure spec guide but it is targeted to developers of specifications.
There are other clojure projects that provide more intuitive spec error messages. I've used expound at the command line and it provides much nicer error messages, however I don't think you can use expound with cursive, but that might be worth exploring.
When I saw your code, I first looked at what the definiation of the defn macro is by doing a ctrl-mouse-over on the defn, or you can look at the online defn documentation. That information along with the spec error let me understand how to interpret the error message.
As for your code, when using defn you don't use (fn. So your code should look like:
(defn fibon [n]
(loop [loops n acc 1N acc2 0N]
(if (<= loops 0)
acc ;; Return the summed F number.
(recur (dec loops) (+ acc acc2) acc))))
The above answer is good. One suggestion to a question you didn't ask: you may wish to adjust your IDEA settings so it only indents 2 spaces each line, instead of 8 spaces (1 tab char?).
If necessary, uncheck the box "Use tab character". Here is a screenshot:
Then it will look like this:
(defn fibon
[n]
(loop [loops n
acc 1N
acc2 0N]
(if (<= loops 0)
acc ;; Return the summed F number.
(recur (dec loops) (+ acc acc2) acc))))
For the loop statement, I like to keep each loop variable and its initial value on a separate line. In this way it looks similar to the Clojure let expression.
Enjoy!

buffer-local values for SQL query parameters

Using sql-send-buffer, I can send a SQL query from a file to an open SQL REPL. Many of my queries have parameter placeholders (in Postgres syntax, $1, $2 &c.) . Does anyone have code analogous to sql-send-buffer that will prompt for values to fill in for these parameters? Ideally, I'd like it to store the values I provide, and not prompt again unless I add parameters or close the file.
Currently I either:
replace the parameters in the file, try to remember not to commit or deploy these test values (error prone)
copy the query into the REPL, replace parameters there (tedious)
Something like this, perhaps:
(defvar my-sql-replacements nil)
(make-variable-buffer-local 'my-sql-replacements)
(defun my-sql-send-buffer-replace ()
(interactive)
(let ((string (buffer-substring-no-properties (point-min) (point-max))))
(while (string-match "[$][0-9]" string)
(let* ((placeholder (match-string 0 string))
(replacement (or (cdr (assoc placeholder my-sql-replacements))
(read-string (format "Replacement for %s: " placeholder)))))
(unless (assoc placeholder my-sql-replacements)
(push (cons placeholder replacement) my-sql-replacements))
(setq string (replace-regexp-in-string (regexp-quote placeholder) replacement string))))
(sql-send-string string)))
I haven't tested it with an actual SQL server, but from tracing sql-send-string it looks like it should work. It stores the replacements in a buffer-local variable.

Delimiting output in Lisp

I'm sure this is a very basic question, but how to output delimited values?
(defun q (n)
(if (<= n 2)
1
(+
(q (- n (q (- n 1))))
(q (- n (q (- n 2)))))))
(loop for x from 1 to 25
do (
write (q x)))
The above outputs the first 25 terms of the Hofstadter Q-sequence, but concatenated:
11233455666888109101111121212121614
Can be comma-, space- or tab-delimited. I tried playing with the format function, but it's way over my head for a Lisp newbie like me.
You can write the delimiter yourself, e. g. (write ", "). You can also write the (platform dependent) line separator with (terpri).
As for format, you can get by with some basic usage at first:
(format <stream> <template> <args…>)
<stream> is where the output should go. For standard output, use t. In order to write to a file, you would use the stream created by with-open-file here.
<template> is a template string. That's just a string, but the ~ character is special. For starters, just use ~a wherever you want to insert an argument.
<args…> are exactly as many further arguments as you used ~a above.
Using this simple toolbox, you could do: (format t "~a, " (q x)) for each item.
Format has a lot of other possibilities, e. g. it can iterate a list by itself, do different output formats and escaping, or even be extended by user functions. Look that up in the hyperspec (e. g. at clhs.lisp.se).
use write-char or, indeed, format:
(format t "~D: ~:D~%" x (q x))

Getting two numbers from STDIN

I want to get two numbers from STDIN and print the sum of them to STDOUT. The following code is my solution:
#lang racket
(displayln (+ (string->number (string-trim (read-line)))
(string->number (string-trim (read-line)))))
If the input is
1
2
Sometimes the output is 3 as expected, but sometimes the output is:
+: contract violation
expected: number?
given: #f
argument position: 1st
other arguments...:
2
context...:
sum.rkt: [running body]
Why is that?
Edit 1
As shown in the following picture:
Edit 2
I wrote the following code to explore the behaviour of my program:
#lang racket
(displayln "Input:")
(define s1 (string-trim (read-line)))
(define s2 (string-trim (read-line)))
(displayln "Output:")
(displayln (string->list s1))
(displayln (string->list s2))
(define n1 (string->number (string-trim s1)))
(define n2 (string->number (string-trim s2)))
(displayln n1)
(displayln n2)
(displayln (+ n1 n2))
My computer is slow, so the Input: line needs some time to come out. If I wait until the line shows up before I type the inputs, the program will behave as I expect:
But if I don't wait for the Input: line and type in my inputs directly, sometimes the error will happen:
So now my questions are:
Does it mean that the error happens because Racket is not initialized yet?
What does R mean?
In the error case, why is the first input correctly interpreted as 1, but the second input wrongly interpreted as R?
(I'm running Racket v6.1.1 under Winodws 7 Pro SP1)
It's best to use (read) to read numbers, assuming you can rely on sane input (i.e., if it's actually going to be numbers and not garbage or, worse, massive S-expressions). Thus your code would be:
(displayln (+ (read) (read)))

An efficient collect function in Common Lisp

I'm learning Lisp and have written the following function to collect a list of results.
(defun collect (func args num)
(if (= 0 num)
()
(cons (apply func args)
(collect func args (- num 1)))))
It produced similar output to the built in loop function.
CL-USER> (collect #'random '(5) 10)
(4 0 3 0 1 4 2 1 0 0)
CL-USER> (loop repeat 10 collect (random 5))
(3 3 4 0 3 2 4 0 0 0)
However my collect function blows the stack when I try to generate a list 100,000 elements long
CL-USER> (length (collect #'random '(5) 100000))
Control stack guard page temporarily disabled: proceed with caution
Whereas the loop version doesn't
CL-USER> (length (loop repeat 100000 collect (random 5)))
100000
How can I make my version more space efficient, are there alternatives to consing? I think it's tail recursive. I'm using sbcl. Any help would be great.
No, it is not tail recursive. Neither ANSI Common Lisp says anything about it nor your code:
(defun collect (func args num)
(if (= 0 num)
()
(cons (apply func args)
(collect func args (- num 1)))))
If you look at your code, there is a CONS around your call to COLLECT. This CONS receives the value of the recursive call to COLLECT. So COLLECT can't be tail recursive. It's relatively simple to rewrite your function to something that looks tail recursive by introducing an accumulator variable. The various Lisp or Scheme literature should describe that.
In Common Lisp the default way to program an iterative computation is by using one of the several iterative constructs: DO, DOTIMES, DOLIST, LOOP, MAP, MAPCAR, ...
The Common Lisp standard does not provide tail call optimization (TCO). It would have to be specified what TCO should do in the presence of several other language features. For example dynamic binding and special variables have an effect on TCO. But the Common Lisp standard says simply nothing about TCO in general and about possible effects of TCO. TCO is not a part of the ANSI Common Lisp standard.
Several Common Lisp implementations have a way to enable various tail call optimizations with compiler switches. Note that both the way to enable those and the limitations are implementation specific.
Summary: In Common Lisp use iteration constructs and not recursion.
(defun collect (func args num)
(loop repeat num
collect (apply #'func args)))
Added bonus: it is easier to read.
Common Lisp implementations are not required by the ANSI standard to do tail call optimization; however, most that worth their salt (including SBCL) do optimize.
Your function, on the other hand, is not tail recursive. It can be turned into one by using the common trick of introducing an extra parameter for accumulating the intermediate result:
(defun collect (func args num)
(labels ((frob (n acc)
(if (= 0 n)
acc
(frob (1- n) (cons (apply func args) acc)))))
(frob num nil)))
(The original parameters FUNC and ARGS are eliminated in the local function since they are constant with recpect to it).
Well, the alternative to recursion is iteration.
You should know that Common Lisp does not require tail recursion from its implementors, unlike Scheme.
(defun mycollect (func args num)
(let ((accumulator '())) ; it's a null list.
(loop for i from 1 to num
do
;;destructively cons up the accumulator with the new result + the old accumulator
(setf accumulator
(cons (apply func args) accumulator)))
accumulator)) ; and return the accumulator