I am a beginer to use/write autocad lisp.
Below is the code I found on Internet. As a beginer I want to modify it and instead of selecting (single line) line1 and line2, I want to do multiple selection of lines (select two lines). Any idea?
;------------------------------------------------------------------------
;- Command: midpts_line ()
;-
;- Draws a line between the midpoints of two lines.
;-
;- Copyright 2008 Jeff Winship. All rights Reserved.
;----------------------------------------------------------------5/3/2008
(defun c:midpts_line ()
;-- Select the lines
(setq line1 (car (entsel "\nSelect the first line: ")))
(setq line2 (car (entsel "\nSelect the second line: ")))
;-- Get the endpoints of the first selected line
(setq pt1 (cdr (assoc 10 (entget line1))))
(setq pt2 (cdr (assoc 11 (entget line1))))
;-- Get the endpoints of the second selected line
(setq pt3 (cdr (assoc 10 (entget line2))))
(setq pt4 (cdr (assoc 11 (entget line2))))
;-- Find the midpoints of the lines
(setq mid1 (midpt pt1 pt2))
(setq mid2 (midpt pt3 pt4))
;-- Draw the line
(command "line" mid1 mid2 "")
)
;------------------------------------------------------------------------
;- Function: midpt ( p1 p2 )
;- Arguments: p1 is the starting point of the line
;- p2 is the ending point of the line
;-
;- Returns the midpoint of a line given two points.
;-
;- Copyright 2008 Jeff Winship. All rights Reserved.
;----------------------------------------------------------------5/3/2008
(defun midpt (p1 p2 / Xavg Yavg Zavg)
;-Calculate the X, Y and Z averages
(setq Xavg (/(+ (car p1) (car p2))2.0))
(setq Yavg (/(+ (cadr p1) (cadr p2))2.0))
(setq Zavg (/(+ (caddr p1) (caddr p2))2.0))
;-Return the midpoint as a list
(list Xavg Yavg Zavg)
)
entsel allows to select only one entity. If You want multiple selection, You should use ssget.
Sample code:
(setq sset(vl-catch-all-apply 'ssget (list )))
(if (not(vl-catch-all-error-p sset))
(progn
(setq i 0)
(repeat (sslength sset)
(setq item (ssname sset i))
(print (entget item) )
(setq i (1+ i))
);repeat
) ; progn
) ;if
SSget is very usefull. You can ask User to select entities, You can also limit selection for user, for example he will be able to select only lines, or only blocks. You can also select entities by defined criteria like layer, color and so one, without any user action.
The previous reply doesn't include the property filter set within (list ) after the 'ssget statement. If you need to filter out everything except for LINE entities, you'll need to include a filter set.
Related
I have several (many) objects in an AutoCAD drawing and each of them has the same attribute field in it's preferences. Now I would like to fill this attribute field with a number (object one - number 1, object two - number 2 and so on). Putting the numbers in manually is very time consuming, therefore I would like to ask you if there's an automated approach for this matter.
Thanks a lot in advance!
An Example
The following program is a very simple example which will prompt you for an attribute tag to be numbered and an integer from which to start the numbering, and will then continuously prompt you to select attributed block references to be numbered, incrementing the number by one for each valid selection:
(defun c:attnum ( / ent enx num tag )
(if (/= "" (setq tag (strcase (getstring "\nSpecify attribute tag <exit>: "))))
(progn
(setq num (cond ((getint "\nSpecify starting number <1>: ")) (1)))
(while
(not
(progn
(setvar 'errno 0)
(setq ent (car (entsel (strcat "\nSelect block number " (itoa num) " <exit>: "))))
(cond
( (= 7 (getvar 'errno))
(prompt "\nMissed, try again.")
)
( (null ent))
( (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
(prompt "\nThe selected object is not a block.")
)
( (/= 1 (cdr (assoc 66 enx)))
(prompt "\nThe selected block is not attributed.")
)
( (progn
(setq ent (entnext ent)
enx (entget ent)
)
(while
(and
(= "ATTRIB" (cdr (assoc 0 enx)))
(/= tag (strcase (cdr (assoc 2 enx))))
)
(setq ent (entnext ent)
enx (entget ent)
)
)
(/= "ATTRIB" (cdr (assoc 0 enx)))
)
(prompt (strcat "\nThe selected block does not contain the attribute \"" tag "\"."))
)
( (entmod (subst (cons 1 (itoa num)) (assoc 1 enx) enx))
(entupd ent)
(setq num (1+ num))
nil
)
( (prompt "\nUnable to edit attribute value."))
)
)
)
)
)
)
(princ)
)
How to Load & Run the Above
Open Windows Notepad.
Copy & paste the above code into Notepad.
Save the file with a filename of your choice, with the file extension .lsp (ensure that Save As Type is set to All Files (*.*)).
Open AutoCAD to a new or existing drawing.
Type APPLOAD at the AutoCAD command-line.
Browse & select the file saved above, and click Load to load the program.
Close the APPLOAD dialog.
Type ATTNUM at the AutoCAD command-line to run the program.
Similar instructions may be found as part of my tutorial on How to Run an AutoLISP Program.
If you wish for the program to be automatically loaded for every new or existing drawing opened in AutoCAD, refer to my tutorial on Loading Programs Automatically.
Other Existing Solutions
In addition to the above, you may also be interested in the following programs:
My Incremental Numbering Suite application will provide a far more extensive set of options to allow you to customise the numbering format, permitting a Prefix & Suffix, multiple incrementing sections, and alphanumerical incrementing.
You can number existing attributed block references using this application by typing 'R' or 'r' at the AutoCAD command-line during object placement to enter Replacement Mode.
My Incremental Array application will allow you to automatically increment the attribute values whilst arraying an attributed block reference (or other objects).
This lsp helps you add a prefix or suffix to any block attribute, but to all blocks at the same time, I had a similar case like yours so I combines above attnum.lsp with this Presuf.lsp.
First use attnum to set tag field to increasing numbers 1,2,3,4,etc. Then isolate the objects and run presuf, indicate whether is a suffix or prefix to add, indicate the desired value and then select all the objects.
(defun c:presuf ( / as el en i ss str typ )
(initget "Prefix Suffix")
(setq typ (cond ((getkword "\nAdd Prefix or Suffix? [Prefix/Suffix] <Prefix>: ")) ("Prefix")))
(setq str (getstring t (strcat typ " to Add: ")))
(if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i))))
(while (eq "ATTRIB" (cdr (assoc 0 (setq el (entget (setq en (entnext en)))))))
(setq as (cdr (assoc 1 el)))
(if (eq "Prefix" typ)
(if (not (wcmatch as (strcat str "*")))
(entmod (subst (cons 1 (strcat str as)) (assoc 1 el) el))
)
(if (not (wcmatch as (strcat "*" str)))
(entmod (subst (cons 1 (strcat as str)) (assoc 1 el) el))
)
)
)
)
)
(princ)
)
If I had the attribute tags, or block names I could take a stab at answering your question with a custom solution, however, I do believe you can find all you need here (BFind or Global Attribute Extractor & Editor).
Using AutoLISP (to be used for AutoCAD 2015), I am working on a script that calculates the total length of all rectangles that are placed on a certain layer.
(Concrete purpose: I have a layer with multiple rectangles representing the wooden beams intended to carry a wooden floor. I want to calculate how many metres of beams I will have to buy for this floor.)
What I have, so far, is a script that calculates the sum of the length of all lines on the layer. This works fine so far. It returns both the overall length of the (circumference) lines of all rectangles on the layer, and the number of rectangles found.
(defun C:PLINELEN (/ ent sset obj len sum layer a)
(setvar "ERRNO" 0)
(while
(and (not (setq ent (car (entsel "Select object on layer: "))))
(/= (getvar "ERRNO") 52)
)
)
(cond ((and ent
(setq sset
(ssget
"X"
(list '(0 . "LWPOLYLINE")
(cons 8 (setq layer (cdr (assoc 8 (entget ent)))))
)
)
)
)
(setq a 0
sum 0
)
(repeat (sslength sset)
(setq obj (vlax-ename->vla-object (ssname sset a))
len (vlax-curve-getDistAtParam
obj
(- (vlax-curve-getEndParam obj)
(vlax-curve-getStartParam obj)
)
)
sum (+ sum len)
)
(setq a (1+ a))
)
(princ (strcat "\nTotal length of "
(itoa a)
(if (= a 1)
" pline on layer "
" plines on layer "
)
layer
": "
(rtos sum)
)
)
)
(T (princ "\nNo plines found"))
)
(princ)
)
What is missing yet is functionality to leave aside all the short sides of the rectangles, and sum up only the long sides.
For my understanding, the simplest solution would be: add functionality to determine the sum of the length of all short sides of the rectangles found on the layer, and then subtract it from "sum")
In pseudocode:
(iterate through all rectangles on the layer
(measure all four sides of the rectangle)
(compare the four measurements and store [one of the] shortest into variable x)
(sumOfShortSides = sumOfShortSides + x)
)
I am most of the way there, but I need a pointers to improve my existing code to drop the short sides. Other solutions are also welcome.
How do I sum up the long sides of all rectangles in a layer?
Instead of using rectangles, why not create a dynamic block with a stretch action that sets the length. This way, you could just iterate all blocks on the required layer with the correct name and query for the dynamic length property.
Yes, this is a possibly huge change in your drafting procedure but it would provide you with what you need.
I'm trying to write a function which takes as parameter a List and calculates the sum of even numbers minus the sum of odd numbers.
Here is my implementation but I have no clue why it is not working as expected, could you give me any hints about whats wrong?
(defun sumEvenOdd (R)
(cond
((NULL R) 0)
((and (ATOM (CAR R)) (= (mod (CAR R) 2) 0))
(+ (CAR R) (sumEvenOdd (CDR R))))
((and (ATOM (CAR R)) (not (= (mod (CAR R) 2) 0)))
(- (CAR R) (sumEvenOdd (CDR R)) ))
((LISTP (CAR R)) (sum (sumEvenOdd (CAR R)) (sumEvenOdd (CDR R))))
(T (sumEvenOdd (CDR R)))
)
)
Regarding the code algorithm, it fails because how the math is being done.
How the code is now, this the evaluation being done with the list (list 1 2 3 4 5) is (- 1 (+ 2 (- 3 (+ 4 (- 5 0))))) that equals 5.
What we were expecting was (2+4)-(1+3+5) that equals -3. What's wrong?
Basically the sum operation in math is commutative, while the subtraction operation is not. 1+5 and 5+1 is the same. 1-5 and 5-1 is not.
This reflects on the code on the last operation where 5 is being subtracted 0.
The simplest solution is to adjust the operation order, switching the arguments.
(defun sumEvenOdd (R)
(cond
((NULL R) 0)
((and (ATOM (CAR R)) (= (mod (CAR R) 2) 0))
(+ (sumEvenOdd (CDR R)) (CAR R)))
((and (ATOM (CAR R)) (not (= (mod (CAR R) 2) 0)))
(- (sumEvenOdd (CDR R)) (CAR R)))
)
)
That way the evaluation will be: (- (+ (- (+ (- 0 1) 2) 3) 4) 5) that equals -3.
PS: You can check and test the code here: http://goo.gl/1cEA5i
You are almost there. Here is an edited version of your code:
(defun sumEvenOdd (R)
(cond
((NULL R) 0)
((and (ATOM (CAR R))
(= (mod (CAR R) 2) 0))
(+ (sumEvenOdd (CDR R)) (CAR R))) ; switched places for consistency
((and (ATOM (CAR R)) (not (= (mod (CAR R) 2) 0)))
(- (sumEvenOdd (CDR R)) (CAR R))) ; operands needed to be switched
((LISTP (CAR R)) (+ (sumEvenOdd (CAR R)) ; what is sum? replaced with +
(sumEvenOdd (CDR R))))
(T (sumEvenOdd (CDR R)))))
Here is a solution using reduce:
(defun sum-even-odd (list)
(reduce (lambda (acc e)
(cond ((consp e) (+ acc (sum-even-odd e)))
((not (numberp e)) acc) ; perhaps not needed
((oddp e) (- acc e))
(t (+ acc e))))
list
:initial-value 0))
(sum-even-odd '(1 2 (3 4 (5 6) 7) 8 9 10)) ; ==> 5
If you are certain the list only has numbers or other lists with numbers the check for something that is not consp nor numberp would be redundant. This does not work for dotted lists.
There are answers with how to fix your code, but let's look at a different implementation.
You don't specify that your function needs to work on a tree so this is for a flat list of numbers.
(defun sum-even-odd (r)
(- (apply #'+ (remove-if-not #'evenp r))
(apply #'+ (remove-if-not #'oddp r))))
remove-if-not takes a list and a predicate function. It run the predicate on each element of the list and create a new list only containing the elements where the predicate didn't return nil.
apply takes a function and a list and calls the function with the arguments being the elements of the list. so (apply #'+ '(1 2 3 4)) is equivalent to (+ 1 2 3 4)
Common lisp has good functions for workings with lists (and many other data types) check em out and your code can end up much cleaner.
Also never use camel-case (or any case based naming) in common lisp and symbols are case insensitive. The symbols HeLloThErE and hellothere and helloThere are the same symbol. This is why you will see hyphens used in names.
I started learning Racket today so please be patient :)
What I'm trying is to sum numbers (ages in this case) stored inside a struct.
So I have this:
(define-struct rec (name age)) ; defining the struct of records
(define r1 (make-rec "Joe" 23))
(define r2 (make-rec "Sue" 13))
(define r3 (make-rec "Ann" 44))
(define reclist (list r1 r2 r3)) ; defining a list of records
I found out how to sum integers, this seems a good way to do that:
(define liste (list 1 2 3 4 5))
(define (sum-list l)
(cond
[(empty? l) 0]
[(+ (first l) (sum-list (rest l)))]))
Now, I have been trying to somehow combine these functions in a way that I can grab the age inside each record and then sum them all but to no avail. I tried different loop constructs but the problem is that it never returns a value but a procedure name.
I know, I'm missing something very basic here but I'm stuck anyway.
Since your sum-list function operates only on numbers you need to project your rec list to a number list. This can be done with a map function. The expression (map rec-age reclist) will yield the number list for you.
Altering your code:
(define (sum-list lst . lkey)
(define key (if (null? lkey) values (car lkey)))
(cond
[(empty? lst) 0]
[(+ (key (first lst)) (sum-list (rest lst) key))]))
Alternative tail recursive version
(define (sum-list lst . lkey)
(define key (if (null? lkey) car (compose (car lkey) car)))
(let loop ((acc 0) (lst lst))
(if (null? lst)
acc
(loop (+ acc (key lst))
(cdr lst)))))
Alternate higher order procedure version in one blob:
(define (sum-list lst . lkey)
(define key (if (null? lkey) values (car lkey)))
(foldl (lambda (x acc)
(+ acc (key x)))
0
lst))
Using map to get the values and apply:
(define (sum-list lst . lkey)
(apply +
(if (null? lkey)
lst
(map (car lkey) lst))))
For many elements this might be more effective:
(define (sum-list lst . lkey)
(foldl +
0
(if (null? lkey)
lst
(map (car lkey) lst))))
All work like this:
(sum-list '(1 2 3 4)) ; ==> 10
(sum-list '((1)(2)(3)(4)) car) ; ==> 10
(sum-list reclist rec-age) ; ==> 80
A function that returns how many times it has been called in Scheme would look like
(define count
(let ((P 0))
(lambda ()
(set! P (+ 1 P))
P)))
(list (count) (count) (count) (count)) ==> (list 1 2 3 4)
But suppose that we have an expression that looks like this
(map ______ lst)
and we want that to evaluate to
(list 1 2 3 ... n)
where n = (length list)
The problem requires we use a lambda statement in the blank, and we cannot use any auxiliary definitions like (count) in the blank, so
(lambda (x) (count))
is not allowed. Simply replacing (count) with the previous definition like this:
(map
(lambda (x)
((let ((P 0))
(lambda ()
(set! P (+ 1 P))
P))))
L)
doesn't work either.
Any suggestions?
You're very, very close to a correct solution! in the code in the question just do this:
The outermost lambda is erroneous, delete that line and the corresponding closing parenthesis
The innermost lambda is the one that will eventually get passed to the map procedure, so it needs to receive a parameter (even though it's not actually used)
Delete the outermost parenthesis surrounding the let form
It all boils down to this: the lambda that gets passed to map receives a parameter, but also encloses the P variable. The let form defines P only once in the context of the passed lambda, and from that point on the lambda "remembers" the value of P, because for each of the elements in the list the same P is used.
You're 90% of the way there. Use the right-hand-side of your count definition in the blank, and add an (ignored) argument to the function.
(define add-stat-var
(let ( (P '()) )
(lambda (x1)
(if (equal? x1 "ResetStatVar") (set! P '()) (set! P (cons x1 P)))
P
) ;lambda
) ;let
) ;define
(define (test-add-stat-var x)
(let* ( (result '()) )
(set! result (add-stat-var 12))
(set! result (add-stat-var 14))
(set! result (add-stat-var 16))
(display (add-stat-var x)) (newline)
(set! result (add-stat-var "ResetStatVar"))
(display (cdr (add-stat-var x))) (newline)
)
)