List and Prompt a specific object entity in AutoLISP - autocad-plugin

I'm struggling with this error I'm getting, I'm new to AutoLISP.
Error message:
bad argument type: stringp (142 . 3000.0)
The only goal at the moment is to prompt a selected specific object entity.
My code is the following:
(defun c:getObjectLenght()
(setq a (car (entsel "\nSelect a object: ")))
(setq b (entget a))
(setq c (assoc 142 b))
(prompt (strcat "\nThe value of 142 is: " c))
(princ)
)
I have tried alot of different solutions and searched the web,but without the result I'm looking for. So I hope someone can point me ind the right direction.
Thx in advance. :)

strcat expect strings but (assoc 142 b) returns list (142 . 3000.0), so You need to convert list to string. depended on entity You select and type of value You should use rtos, itoa or vl-princ-to-string
I suppose what You need is:
(strcat "\nThe value of 142 is: " (vl-princ-to-string (cdr(assoc 42 b ) ) ))

As per I know uses of assoc function is to find key value in associative list, this is like dictionary search you need to give key to search specific value check more here.
and after applying function assoc it's output is in list format see below example.
(assoc 8 (entget (car (entsel)) ))
After selecting entity output like
(8 . "0") This is layer name of selected entity in your case name may be different
Check one More Example
(assoc 10 (entget (car (entsel)) ))
After selecting entity ouput is
(10 3.25 5.5 0.0) The output value is insert co-ordinate of selected entity.
Note that Strcat function Join only string check more here.
In your function at line no 5, you try to Join String with list that why error is occurs.
As you mention error, I think you need to join value 3000.0.
for that you can change your function as below.
(defun c:getObjectLenght()
(setq a (car (entsel "\nSelect a object: ")))
(setq b (entget a))
(setq c (if (assoc 142 b) (rtos (cdr (assoc 142 b))) "Not Found" ) )
;Note that rtos function use to convert decimal value into sting.
; And if condition use in case entity not contain Key value 142 so to avoid error.
(prompt (strcat "\nThe value of 142 is: " c))
(princ)
)
I never come across DXF code assoc 142 I google for that but not found much.

Related

Scheme higher-order function

I try to create a procedure that converts a binary number in a list to a string. Sample output: (binary->string '(1 1 0 1 0 0)) should give "110100".
(define reduce
(lambda (op base x) ;passing by name
(if (null? x)
base
(op (car x) (reduce op base (cdr x))))))
And here is my code:
(define (binary->string lst)
(reduce (number->string lst list->string )))
I know it is wrong but it is the best I came out with so far. Please help me to make it work properly.
Before I will show you solution, here is some advice: when you write Racket code, you should check correct number of arguments and their type.
In this case, you know that reduce needs (op base x), that are three arguments, but when you use some unknown function, like number->string, there is Racket documentation and after short search, you fill find number->string entry:
(number->string z [radix]) → string?
z : number?
radix : (or/c 2 8 10 16) = 10
Returns a string that is the printed form of z (see Printing Numbers) in the base specified by radix. If z is inexact, radix must be 10, otherwise the exn:fail:contract exception is raised.
Examples:
(number->string 3.0)
"3.0"
(number->string 255 8)
"377"
As you can see, you can call this function with one or two arguments, but in both cases, they have to be number. But with this call (number->string lst list->string ), you are passing list and procedure- so I can already tell that your code will end with error. And when you try to call your function in REPL, exactly this happens:
> (binary->string '(1 0 0 1))
. . number->string: contract violation
expected: number?
given: '(1 0 0 1)
argument position: 1st
other arguments...:
After you carefully check what did you write, you should be able to predict what will happen, before you even run your code.
Here is solution:
(define (binary->string lst)
(reduce string-append "" (map number->string lst)))
You will use map to create string from each number in list, then you join these strings with your reduce and string-append.

How to store user input into a list in Scheme?

I need to be able to take input from a user (store it in a list) and and print it to the screen to prove it was stored in a list or print #f if the list contains an element that is not a number. The idea is to then use the result of that function in another that will give me the sum (I've already made that function). I have been looking all over and can not find any information on how to do this in Scheme. I know let has to be used, but I am not sure how I would implement it.
(read-user-ints)
=>1
=>2
=>3
=>4
=>5
=>e
(1 2 3 4 5)
start with defining e to be the empty list.
(define e '())
then you can use a recursive loop with READ to get ints, each time you get one you can append it onto the end of your list like this:
(set! e (append e (list number)))
If you were struggling with the LET part, you can do something like this
(let loop ((number (read)))
;; check if number is actually a number or if it's 'e'
;; either append it or exit the loop (by not calling loop)
)
Answering your follow up comment.
You can use BEGIN to put multiple statements in one branch of an IF expression, like this:
(define read-int-list
(lambda ()
(let loop ((number (read)))
(if (number? number)
(begin (set! e (append e (list number)))
(loop))
'done
))))

DrRacket define begin set! probably should work but dont

Im learning for exam of programming in lisp using DrRacket..
In presentation from lectures i found this code:
(define (f a b c)
(define delta)
(begin
(set! delta (- (* b b) (* 4 a c))
(if (>=? delta 0)
(writeln ”są pierwiastki”)
(writeln ”nie ma pierwiastków)))))
But it dont work.
DrRacket is showing:
. define: bad syntax (missing expression after identifier) in: (define delta)
Can't I set delta value later?
What is the problem?
thanks in advance
The original error message is because
(define delta)
is missing a value. Instead it should be something like:
(define delta 0)
There some other issues:
The double quotes weren't the " character and weren't recognized
by Racket.
Some parens were wrong.
Also I don't know why it was define-ing delta, then immediately
set!-ing it.
I tried to fix/simplify what you posted, and came up with the
following. But I'm not really sure what the function is supposed to
do, so I don't know if the example output is correct.
#lang racket
(define (f a b c)
(define delta (- (* b b) (* 4 a c)))
(if (>= delta 0)
(displayln "są pierwiastki")
(displayln "nie ma pierwiastków")))
;; Example output:
(f 1 2 3)
;;-> nie ma pierwiastków
(f 1 200 3)
;;-> są pierwiastki
Try this:
#lang racket
(define (f a b c)
(define delta 0)
(set! delta (- (* b b) (* 4 a c)))
(if (>= delta 0)
(displayln "są pierwiastki")
(displayln "nie ma pierwiastków")))
What was wrong with your code:
It's probably a copy-paste error, but in Scheme we delimit strings using the " character, not ” as in your code. And the last line is missing the closing ".
Although some interpreters accept a define without an initial value, the standard is that a value must be present after the variable name
A closing parenthesis is missing at the end of the set! line
The define and set! lines can be merged into a single line: (define delta (- (* b b) (* 4 a c)))
The >=? operator is not standard in Scheme, it might work in your interpreter but if possible use the standard >=
The writeln procedure is not standard in Scheme, in Racket you can substitute it for displayln
Not really an error, but you don't need to write a begin inside a procedure definition, it's implicit
In conclusion: the code in the question seems to be intended for a different interpreter, this question was tagged racket but believe me, what you have is not valid Racket code - heck, is not even standard Scheme. Make sure to use the correct interpreter, and be very alert for typos in the text.
I think Greg already has a perfect answer to your problem, but I just want to add the obvious let version of his code as well:
;; for a given ax^2+bx+c=0
;; this displays if it has at least one
;; real number answer or not
(define (equation-has-answer a b c)
(let ((delta (- (* b b) (* 4 a c))))
(if (>= delta 0)
(displayln "Has answer(s)")
(displayln "Has no answers"))))
To just make a predicate you can do this:
;; for a given ax^2+bx+c=0
;; this returns #t if it has at least one
;; real number answer and #f otherwise
(define (equation-has-answer? a b c)
(>= (- (* b b) (* 4 a c)) 0))

MIT Scheme Message Passing Abstraction

In a Computer Science course I am taking, for homework, we were tasked with several different questions all pertaining to message passing. I have been able to solve all but one, which asks for the following:
Write a mailman object factory (make-mailman) that takes in no parameters and
returns a message-passing object that responds to the following messages:
'add-to-route: return a procedure that takes in an arbitrary number of mailbox objects
and adds them to the mailman object's “route”
'collect-letters: return a procedure that takes in an arbitrary number of letter objects and
collects them for future distribution
'distribute: add each of the collected letters to the mailbox on the mailman's route whose
address matches the letter's destination and return a list of any letters whose destinations
did not match any mailboxes on the route (Note: After each passing of
'distribute
the
mailman object should have no collected letters.)
Some remarks that are given to make the code easier include:
If multiple letters are distributed to the same mailbox in one distribution round, any one
of them may be the “latest” letter whose message is returned by passing 'get-latest-message
to the mailbox.
No two mailboxes will have the same address.
No mailbox or letter will be passed to the mailman more than once.
The bad letters returned by distribute do not need to be in a specific order.
Use the . args syntax for accepting arbitrary amount of arguments.
This is what I have been able to figure out for myself:
(define (make-mailman)
(let ((T '()))
(define (route-adder . mobjects)
(assoc mobjects T))
(define (letter-collecter . lobjects)
(assoc lobjects T))
(define (add-to-route mobjects)
(begin (set! T (cons (route-adder . mobjects) T)) 'done))
(define (collect-letters lobjects)
(begin (set! T (cons (sort-strings (letter-collecter . lobjects)) T)) 'done))
(define (dispatch z)
(cond ((eq? z 'add-to-route) add-to-route)
((eq? z 'collect-letters) collect-letters)
((eq? z 'distribute) "unsure of what to do here")
(else "Invalid option")))
dispatch))
Any help that can be given to me here will be appreciated, as I have tried looking at this problem for a while, and cannot figure out what to do from here.
Your code has all kinds of mix-ups. :) Let's proceed step by step.
The dispatch bit is almost OK:
(define (make-mailman)
(let ...
...
(define (dispatch msg) ;; use short but suggestive var names
(cond
((eq? msg 'add-to-route) add-to-route)
((eq? msg 'collect-letters) collect-letters)
((eq? msg 'distribute)
;; "unsure of what to do here" <<-- Distribute the letters, what else?
distribute-the-letters)
(else "Invalid option")))
dispatch))
With such objects, a sample call will be (define ob (make-mailman)) and then ((ob 'add-to-route) box1 box2 ... boxn) etc. So add-to-route procedure must be defined this way:
(define (make-mailman)
(let ((self (list '(ROUTE) ; each mailman has a route, and a mailbag
'(MAILBAG)))) ; use suggestive name here (T, what T?)
...
(define (add-to-route . mailboxes)
(let ((route (assoc 'ROUTE self)))
(set-cdr! route
(append mailboxes ; there will be no duplicates
(cdr route)))
'DONE))
Right? Same with the letters:
(define (collect-letters . letters)
(let ((mailbag (assoc 'MAILBAG self)))
.....
'DONE))
Now we can deal with the missing part, distribute-the-letters:
(define (distribute-the-letters)
;; for each letter in my mailbag
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters) ()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
;; access its address,
(let* ((address (letter 'get-address))
;; (we assume it supports this interface,
;; or maybe that's part of a previous assignment)
;; and find a mailbox on my route such that
(mbx (find-mailbox address mailboxes)))
;; its address matches the letter's
;; and if so,
(if .....
;; put that letter into this mailbox:
((mbx 'put-letter) letter)
;; (we assume it supports this interface,
;; or maybe that's part of a previous assignment)
;; but if not, add letter to the "not-delivered" list
..... )
(if (null? letters)
;; having emptied the mailbag, return the "not-delivered" list
(begin (set-cdr! mailbag nil) not-delivered)
(loop (car letters) (cdr letters) not-delivered)))))))
We assume that both letter and mailbox objects support the message type 'get-address to which they both return the same comparable address type of object, and that mailbox objects support 'put-letter message.
Other than the specifics of the message functionality, it looks like you've nailed it. There are however some errors:
This (route-adder . mobjects) should be (router-adder objects) and similarly for (letter-collector . lobjects).
The use of begin is unneeded. The body of a (define (func . args) <body> ...) is implicitly enclosed in a begin.
Idiomatically your code could be written as:
(define (make-mailman)
(let ((T '()))
;; ...
(lambda (z)
(case z
((add-to-route) add-to-route)
((collect-letters) collect-letters)
((distribute) distribute)
(else (error "Invalid option"))))))
[but you may not know about case nor lambda yet...]
As for solving the actual messaging functionality. You are going to need to maintain a set of mailboxes where each mailbox is going to hold a set of letters. A letter will presumably consist of an address and some content (extra credit for a return-address). The distribute behavior will check the address on each letter and deposit it in its mailbox. The mailman will need to hold letters (while on his route collecting-letters) until instructed to distribute.
For this you might start by building up the lower-levels of the functionality and then using the lower-levels to build up the actual message passing functionality. Starting like, for example:
(define (make-letter addr content)
`(LETTER ,addr ,content))
(define letter-addr cadr)
;; ...
(define (make-mailbox addr)
'(MBOX ,addr))
(define mailbox-letters cddr)
(define (mailbox-letters-add mailbox letter)
(set-cdr! (cdr mailbox) (cons letter (mailbox-letters mailbox))))
;;...

Using append to create a list from a line of text

I want to create a list of words from a line of text delimitted by tabs. I want to basically split the line into atoms, split by tab.
The code below is sort of pseudocode but is this the best approach to do this type of thing?
Here is my first attempt:-
(defun get-hdr()
;obviously point must be positioned on correct line
(let (mylist)
(while(not (end-of-line)
(while(re-search-forward ("[A-Za-z]+[^\t\n]" nil t)
(append (match-string 1) mylist)
))
))
)
)
How do I get my function to return the list, mylist?
You just evaluate it at the end of the loop.
(defun get-hdr ()
(let (mylist)
(while (not (end-of-line)) ; missing closing parenthesis added
(while (re-search-forward ("[A-Za-z]+[^\t\n]" nil t)) ; ditto
(setq mylist (append (match-string 1) mylist)) ) ) ; note setq
mylist) )
It is customary to just use cons instead of append in this sort of scenario, though; then at the end, you might want to reverse the list.
(defun get-hdr ()
(let (mylist)
(while (not (end-of-line))
(while (re-search-forward ("[A-Za-z]+[^\t\n]" nil t))
(setq mylist (cons (match-string 1) mylist) ) ) )
(reverse mylist)) )
See also http://www.gnu.org/software/emacs/manual/html_node/elisp/Building-Lists.html which discusses the functionality of append in a wider context.
In many scenarios, your function should not mess with the user's regex match data or buffer position; consider adding save-excursion and perhaps save-match-data wrappers around the let form.
For your stated purpose, though, perhaps all you need is
(split-string (buffer-substring-no-properties (point) (line-end-position)) "\t")
(Documentation)

Resources