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).
Related
I am working with groups in AutoCAD and, due to copy pasting them from different drawings, they ungroup.
In the possibility of me forgetting to regroup them, I want to create a code that, when I think I am finished with the drawing, can check if a list of blocks (every group has a block) is not inside a group.
As such, the idea is that it would run from a selection of blocks (ex: block1, block3, block7) and check if those particular blocks are grouped. If not, it would tell me which block is ungrouped.
As the tags suggest, either vba or autolisp is fine. I am fairly novice at this, any help would be fairly appreciated.
edit: knowing how I could get a block group name in vba would be great
Background
A block definition may have many block references: the block definition is analogous to the blueprints for a building, with each block reference analogous to the construction of the building itself.
As such, given only a list of block names, each block name may correspond to multiple block references, with some contained within groups, and others not.
Methods
You can therefore approach this task from two angles:
Iterate over all Groups defined within the drawing (either using the ActiveX Groups Collection, or the ACAD_GROUP dictionary contained within the Named Object Dictionary), and obtain the set of distinct block names corresponding to blocks contained within at least one Group.
OR
Iterate over all Block References within the drawing and test whether the block reference has a link to a GROUP entity via an {ACAD_REACTORS} entry in the DXF data. Compile a list of block names corresponding to blocks which are either contained within at least one group, or not contained within any group.
Given such a list, you can then easily test whether any of your block names are not present in the list.
Sample Code
Below is a function that will iterate over all Groups defined within the ACAD_GROUP dictionary of the Named Object Dictionary, and will return a list of the names of block references contained within one or more groups:
(defun blocknamesfromgroups ( / blk dic enx grp rtn )
(if (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
(while (setq grp (dictnext dic (not grp)))
(foreach itm grp
(if (and (= 340 (car itm)) (= "INSERT" (cdr (assoc 0 (setq enx (entget (cdr itm)))))))
(if (not (member (setq blk (cdr (assoc 2 enx))) rtn))
(setq rtn (cons blk rtn))
)
)
)
)
)
(reverse rtn)
)
Alternatively, the below function will iterate over all primary block references in the active drawing and will report the names of block references not contained within a group:
(defun blocknamesnotgrouped ( / blk enx grp idx sel rtn )
(if (setq sel (ssget "_X" '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(setq idx (1- idx)
enx (entget (ssname sel idx))
blk (cdr (assoc 2 enx))
)
(if
(not
(or
(and
(setq enx (member '(102 . "{ACAD_REACTORS") enx))
(setq grp (cdr (assoc 330 enx)))
(= "GROUP" (cdr (assoc 0 (entget grp))))
)
(member blk rtn)
)
)
(setq rtn (cons blk rtn))
)
)
)
(reverse rtn)
)
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.
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 know what I want to do, I am having trouble getting there. I am looking for some guidance. I am more or less forcing what I want done and there has to be a better way than the way I am trying to create this function. I currently get an unbound variable error right where I call (set! nadj) and (set! count).
I am trying to make a function where the user inputs a sentence. If more than 25% of that sentence consists of adjectives the function returns false.
This is what I have so far:
(define OK
(lambda (x)
(cond
((adj? (car x))
(set! count (+ count 1)))
((not (adj? (car x))
(set! nadj (+ nadj 1))))
((not (null? (OK (cdr x)))))
((null? x)
(set! sum (+ nadj count)))
;;(set! div (/ count sum))
;;(* 100 div)
;;(< div 25))
((else #f)))))
What I am trying to do is make a counter for the words that are an adjective and a counter for the words that are not. Then I am trying to add all of the words up and divide them by the amount of words that were adjectives. I then want to multiply that by 100 and return true if it is less than 25%. I am not looking for an answer, more or less I just want some guidance.
Here is the adj? function if you need to see it.
(define adjectives '(black brown fast hairy hot quick red slow))
(define adj?
(lambda(x)
(if ( member x adjectives) #t #f)))
I am sure this isn't normal Scheme notation. I program a lot in C++ and Java and I am having a hard time transitioning into Scheme.
You're correct in stating that your solution is not idiomatic Scheme - we try really hard to avoid mutating variables, all those set! operations are frowned upon: we don't really need them. A more idiomatic solution would be to pass along the counters as parameters, as demonstrated in #uselpa's answer. His solution uses explicit recursion via a named let.
We can go one step further, though - the true spirit of functional programming is to reuse existing higher-order procedures and compose them in such a way that they solve our problems. I don't know which Scheme interpreter you're using, but in Racket the OK procedure can be expressed as simply as this:
(define (OK x) ; assuming a non-empty list
(< (/ (count adj? x) ; count the number of adjectives
(length x)) ; divide by the total number of words
0.25)) ; is it less than 25%?
If your Scheme interpreter doesn't provide a count procedure import it from SRFI-1; also it's very easy to implement your own - again, this is in the spirit of functional programming: we want to build generic procedures that are useful in their own right, and easily reused and composed in other contexts:
(define (count pred lst)
(let loop ((lst lst) (counter 0))
(cond ((null? lst) counter)
((pred (car lst)) (loop (cdr lst) (+ 1 counter)))
(else (loop (cdr lst) counter)))))
Playing Devil's advocate it's possible to fix your function using an imperative style, as long as we define the variables first (by the way, that was causing the "unbound variable" error) - for example, place a let before the looping function: think of it as a variable declaration that happens before the recursion starts. Also notice that the empty list case must appear first, to avoid accessing an element in an empty list, and don't forget to advance the recursion at each step. This is ugly, but should work:
(define (OK x) ; assuming a non-empty list
; declare the counters outside the function
(let ((adj 0) (nadj 0))
; looping function
(let loop ((x x))
(cond
; is the list empty?
((null? x)
; is the number of adjectives less than 25%?
(< (/ adj (+ adj nadj)) 0.25))
; is current element an adjective?
((adj? (car x))
; increment adj counter
(set! adj (+ adj 1))
; always advance recursion
(loop (cdr x)))
; is current element anything other than an adjective?
(else
; increment nadj counter
(set! nadj (+ nadj 1))
; always advance recursion
(loop (cdr x)))))))
I don't know if you are familiar with the named let, but this comes in handy here:
(define (OK x)
(let loop ((x x) (adj 0) (nadj 0)) ; named let
(cond
((null? x) (< (/ adj (+ adj nadj)) 0.25))
((adj? (car x)) (loop (cdr x) (+ 1 adj) nadj))
(else (loop (cdr x) adj (+ 1 nadj))))))
This is a convenient notation for the following, equivalent code:
(define (OK x)
(define (loop x adj nadj)
(cond
((null? x) (< (/ adj (+ adj nadj)) 0.25))
((adj? (car x)) (loop (cdr x) (+ 1 adj) nadj))
(else (loop (cdr x) adj (+ 1 nadj)))))
(loop x 0 0))
so basically we define an internal function, and what is a loop in a language such as C++ and Java becomes a recursive call (and to add to the confusion, the procedure that gets called recursively is sometimes called loop, as in my example). Since the call is done in tail position, this is just as efficient in Scheme as a classic loop in the languages you mentioned.
Variable assignments are replaced by modifying the parameters of the recursive call, i.e. you usually find no set! procedures in such a simple case.
EDIT an example implementation using set!:
(define OK
(let ((adj 0) (nadj 0))
(lambda (x)
(cond
((null? x) (< (/ adj (+ adj nadj)) 0.25))
(else (if (adj? (car x))
(set! adj (+ 1 adj))
(set! nadj (+ 1 nadj)))
(OK (cdr x)))))))
You can't set an unbound variable, even a global one. Variables refer to locations; setting a variable that doesn't exist anywhere is impossible:
(set! a 1)
;Unbound variable: a ; a doesn't refer to any location yet
(define a)
;Value: a
(list a)
;Unassigned variable: a ; now it does, but it hasn't been assigned a value yet
(set! a 1)
;Value: a
(list a)
;Value: (1)
(set! a 2)
;Value: 1
(list a)
;Value: (2)
There's nothing wrong with localized and encapsulated mutation. Setting a global variable is by definition not localized.
You should have created local bindings (locations) for the variables you intended to use. The basic iteration built-in form do does it for you:
(define (OK x)
(do ((adj 0) (nadj 0))
((null? x) ; loop termination condition
(< (/ adj (+ adj nadj))
0.25)) ; return value form
; loop body
(if (adj? (car x))
(set! adj (+ adj 1))
; else
(set! nadj (+ nadj 1)))
; some other statements maybe...
))
Just another option that sometimes might come handy. Of course the most idiomatic Scheme code is using named let construct. It will also force you to refactor a spaghetti code that you might otherwise write using do. Don't. :)
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