TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ELOQUINTET on August 18, 2005, 02:20:48 PM
-
i have been given the task of developing a lisp. let me explain a little deeper before i go any further. we have a symbol which is a circle with an m inside with an attribute which we use to number our motors. we have a couple routines for this task. one will increment the number upon insertion but some users don't use it. :roll: another one will change the attribute values by a given number. i have been asked to develop a routine that would increment them by one in the order that they are selected. has anyone written anything like this or would anyone be willing to help guide me along?
-
Is this close?
;;Automatic Sequential Numbering and Lettering
(defun *ERROR* (MSG)
(princ MSG)
(princ "\nFunction cancelled")
(princ)
)
(defun SQN ()
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel "\n - Select Text to Number"))))
(while ENT
(if (or (= (cdr (assoc 0 ENT)) "TEXT")
(= (cdr (assoc 0 ENT)) "ATTRIB"))
(progn
(entmod
(subst (cons 1 SEQ) (assoc 1 ENT) ENT)
)
(entupd (cdr (car ENT)))
(setq SEQ (itoa (1+ (read SEQ))))
)
(princ "\nEntity Must be TEXT")
)
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel " - Select Text: "))))
(setq *SEQ (itoa (1+ (read SEQ))))
)
)
(defun SQL ()
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel "\nSelect Text to Letter"))))
(while ENT
(if (or (= (cdr (assoc 0 ENT)) "TEXT")
(= (cdr (assoc 0 ENT)) "ATTRIB"))
(progn
(entmod
(subst (cons 1 SEQ) (assoc 1 ENT) ENT)
)
(entupd (cdr (car ENT)))
(setq SEQ (chr (1+ (ascii SEQ))))
)
(princ "\nEntity Must be TEXT")
)
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel " - Select Text: "))))
(setq *SEQ (chr (1+ (ascii SEQ))))
)
)
(defun C:SEQ (/ SEQ ENT)
(if (not *SEQ)
(setq *SEQ "1")
)
(princ (strcat "\nStarting Letter or Number <" *SEQ "> :"))
(setq SEQ (getstring))
(if (not (read SEQ))
(setq SEQ *SEQ)
(setq *SEQ SEQ)
)
(setq NUM (numberp (read SEQ)))
(setvar "cmdecho" 0)
(graphscr)
(if (not NUM)
(SQL)
(SQN)
)
(setvar "cmdecho" 1)
(princ)
)
-
Dan,
This is one I use. I stripped it out of a bigger routine. It is written specifically for my block so if you send me your block I can change mine to work for yours.
(defun c:inc (/ ref tobj tstr ttag sel)
;
(defun *dxf* (gcode elist)
(cdr (assoc gcode elist))
)
;
(defun *get_atts* (obj)
(vlax-safearray->list
(vlax-variant-value
(vla-getattributes
(if (eq (type obj) 'ENAME)
(vlax-ename->vla-object obj)
obj
)
)
)
)
)
;
(defun *find* (attlist nlst)
(vl-remove-if-not
'(lambda (x)
(vl-remove-if-not
'(lambda (y)
(eq (vla-get-tagstring x) y)
)
nlst
)
)
attlist
)
)
;
(defun *put* (obj str lst)
(mapcar '(lambda (x)
(vl-catch-all-apply
'vla-put-textstring
(list (rt:remove obj x) str)
)
)
lst
)
)
;
(defun rt:remove (obj str)
(car
(vl-remove-if-not
'(lambda (x)
(eq (vla-get-tagstring x) str)
)
(*get_atts* obj)
)
)
)
;
(if (and (setq ref (car (entsel "\nSelect reference block: ")))
(eq "INSERT" (*dxf* 0 (entget ref)))
)
(progn
(setq tobj (car (*find* (*get_atts* ref) '("DOOR#" "999" "1")))
tstr (vla-get-textstring tobj)
ttag (vla-get-tagstring tobj)
)
(while tstr
(setvar "ErrNo" 0)
(if
(not
(setq sel (car (entsel "\nSelect attribute to update: ")))
)
(if (/= 52 (getvar "ErrNo"))
(princ "\nNo object selected, please try again: ")
(progn
(princ "\nRight click detected - Terminate program. ")
(setq tstr nil)
)
)
(cond ((not (setq tstr (itoa (1+ (atoi tstr))))))
((eq ttag "1") (*put* sel tstr '("1")))
((eq ttag "DOOR#")
(*put* sel tstr '("DOOR#" "240-DOOR#" "96-DOOR#"))
)
((eq ttag "999") (*put* sel tstr '("999" "101")))
)
)
)
)
(*error* (princ "\nNothing selected. *INVALID*"))
)
)
-
This is close to what you're looking for:
(defun AttribNr (/ nwmaat OK ss1 ss2 ss4 g g1 dr type)
(command ".undo" "begin")
(initget "Yes No")
(setq dr (getkword "\nRotate attribute horizontal? <Y> /n "))
(if (= dr "No")(setq dr nil)(setq dr T))
(setq nwmaat (getstring "\nNumber/letter of first block? "))
(if (wcmatch (substr nwmaat 1 1) "[0-9]")(setq type "getal")(setq type "letter"))
(if (= type "getal")(setq nwmaat (atoi nwmaat))(setq nwmaat (ascii nwmaat)))
(princ "\nSelect blocks one by one...\n")
(while (not OK)(progn
(if (= type "getal")
(setq vulin (itoa nwmaat))
(setq vulin (chr nwmaat))
)
(princ (strcat "\n\n" fill in ":"))
(setq ss1 (car (entsel)))
(if ss1
(progn
(setq ss2 (entnext ss1))
(setq ss4 (entget ss2))
(setq g (cons '1 vulin))
(setq g1 (subst g (assoc 1 ss4) ss4))
(entmod g1)
(entupd ss1)
(if dr (command ".attedit" "" "" "" "" ss2 "a" "0" ""))
)
(setq OK T)
)
(setq nwmaat (1+ nwmaat))
))
(command ".undo" "end")
(princ)
)
-
Visit my homepage -> Free Stuff -> Free Programs and DL ItemIndex.lsp
-
biscuits comes the closest to what i'm looking for but the onlt problem with the routine is what if the attribute is left empty. i can't imagine this situation happening but my boss might be annoyed that she gave me this as a exercise and i found one :P i will upload the block to the pond so maybe the other routines could be tweaked to work. thanks everybody
-
here's a drawing containing the block
http://www.theswamp.org/lilly_pond/dan/attiinc.dwg?nossi=1
-
i noticed another problem biscuit. if the user selects either the m or the text on top the counter gets screwed up. this is a good starting point but has a few bugs that need to be worked out.
-
At least it's a starting point. I found this routine a few years back and can take no credit for writing it. Sorry, I'm still at the beginner level and can't be of any further help. Maybe one of the more advanced members can help. Good luck
-
Here is one I wrote a little while ago. Kinda rough...
;; written by me :) ImaJayhawk (Jonathan)
;; attyinc incrimits attributes of blocks
(defun c:attyinc (/ strg strg2 ss numobj en enlist en2 enlist2 summy changey)
(initget 1)
;;;(setq strg (strcase (getstring "\nATTRIB Tag To Change: ")))
(setq strg "NUMB")
(setq strg2 (getreal "\nStarting Value: "))
(and (setq ss
(ssget (list (cons 0 "INSERT")
(cons 66 1)
(cons 67 (if (= (getvar "TILEMODE") 1) 0 1)))))
(setq numobj (sslength ss)
numobj2 (sslength ss))
(while (not (minusp (setq numobj(1- numobj))))
(setq en (ssname ss (- (1- numobj2) numobj))
enlist (entnext en))
(while (= "ATTRIB" (cdr (assoc 0 (entget enlist))))
(setq en2 (entget enlist)
enlist2 (strcase (cdr (assoc 2 en2))))
(if (= enlist2 strg)
(progn
(setq changey (subst (cons 1 (rtos strg2 2 0)) (assoc 1 en2) en2)
strg2 (1+ strg2))
(entmod changey)
(entupd enlist)))
(setq enlist (entnext enlist)))))
(princ)
)
-
Hi Dan
Seems that ItemIndex does the stuff. The only thing you've to do is to change block name and attribute name in the code: ; ----------------------------- Setting default values:
BlkNme "M4" ;Block name
AttNme "NUMB" ;Attribute name
DefMde "Numeric" ;Default mode
-
Dan,
I modified my code for your block. It prompts you for a reference block and then will ask for blocks to be updated until you give it a right click. An example would be if the reference block you select already has a number 10 in it then the next blocks you select would progress by 1 (ie 11, 12, 13, 14, ...).
Hope this helps,
(defun c:inc (/ ref tobj tstr ttag sel)
;
(defun *get_atts* (obj)
(vlax-safearray->list
(vlax-variant-value
(vla-getattributes
(if (eq (type obj) 'ENAME)
(vlax-ename->vla-object obj)
obj
)
)
)
)
)
;
(defun *find* (attlist nlst)
(vl-remove-if-not
'(lambda (x)
(vl-remove-if-not
'(lambda (y)
(eq (vla-get-tagstring x) y)
)
nlst
)
)
attlist
)
)
;
(defun *put* (obj str lst)
(mapcar '(lambda (x)
(vl-catch-all-apply
'vla-put-textstring
(list (rt:remove obj x) str)
)
)
lst
)
)
;
(defun rt:remove (obj str)
(car
(vl-remove-if-not
'(lambda (x)
(eq (vla-get-tagstring x) str)
)
(*get_atts* obj)
)
)
)
;
(if (and (setq ref (car (entsel "\nSelect reference block: ")))
(eq "INSERT" (cdr (assoc 0 (entget ref))))
)
(progn
(setq tobj (car (*find* (*get_atts* ref) '("NUMB")))
tstr (vla-get-textstring tobj)
ttag (vla-get-tagstring tobj)
)
(while tstr
(setvar "ErrNo" 0)
(if
(not
(setq sel (car (entsel "\nSelect attribute to update: ")))
)
(if (/= 52 (getvar "ErrNo"))
(princ "\nNo object selected, please try again: ")
(progn
(princ "\nRight click detected - Terminate program. ")
(setq tstr nil)
)
)
(cond ((not (setq tstr (itoa (1+ (atoi tstr))))))
((eq ttag "NUMB") (*put* sel tstr '("NUMB")))
)
)
)
)
(*error* (princ "\nNothing selected. *INVALID*"))
)
)
-
whoops missed all the replies. i'll tweak each one and let you guys know what happens. thanks a bunch everyone
-
OK so you've had 11 minutes to tweak...so whose is the best?
-
yours of course will. that does exactly what i want. jurg yours does not do what i want. this is not for doing bubbles. look at my posted drawing. my boss got pissed at me when i told her i got it from somebody because she wanted me to use it as an exercise. i feel kinda bad because she's right but i was sure someone had done and i'm still accustomed to begging.
-
jurg yours does not do what i want.
Of course does my program what you want and also a lot more.my boss got pissed at me when i told her i got it from somebody because she wanted me to use it as an exercise. i feel kinda bad because she's right but i was sure someone had done and i'm still accustomed to begging.
That's your problem if you adorn oneself with borrowed plumes. The main problem in this case, let's face it, is that my published programms are copyright and that's visible...
-
yours of course will. that does exactly what i want. jurg yours does not do what i want. this is not for doing bubbles. look at my posted drawing. my boss got pissed at me when i told her i got it from somebody because she wanted me to use it as an exercise. i feel kinda bad because she's right but i was sure someone had done and i'm still accustomed to begging.
I'm glad I could help you E. Next time if you tell everyone this is a learning exercise and to not post finished code then we can just give you hints and good practice methods.
-
i ran into a couple of snags with will's routine and was wondering if anyone could help me improve it. first i would like it to prompt the user for the attribute name so it would work universally instead of on a single block. secondly i would like to modify it so the user selects the attributes in the order they want and it numbers them all at once not with each pick. this last one is a request from my boss. any takers???
(defun c:attnumb (/ ref tobj tstr ttag sel)
;
(defun *get_atts* (obj)
(vlax-safearray->list
(vlax-variant-value
(vla-getattributes
(if (eq (type obj) 'ENAME)
(vlax-ename->vla-object obj)
obj
)
)
)
)
)
;
(defun *find* (attlist nlst)
(vl-remove-if-not
'(lambda (x)
(vl-remove-if-not
'(lambda (y)
(eq (vla-get-tagstring x) y)
)
nlst
)
)
attlist
)
)
;
(defun *put* (obj str lst)
(mapcar '(lambda (x)
(vl-catch-all-apply
'vla-put-textstring
(list (rt:remove obj x) str)
)
)
lst
)
)
;
(defun rt:remove (obj str)
(car
(vl-remove-if-not
'(lambda (x)
(eq (vla-get-tagstring x) str)
)
(*get_atts* obj)
)
)
)
;
(if (and (setq ref (car (entsel "\nSelect reference block: ")))
(eq "INSERT" (cdr (assoc 0 (entget ref))))
)
(progn
(setq tobj (car (*find* (*get_atts* ref) '("NUMB")))
tstr (vla-get-textstring tobj)
ttag (vla-get-tagstring tobj)
)
(while tstr
(setvar "ErrNo" 0)
(if
(not
(setq sel (car (entsel "\nSelect attribute to update: ")))
)
(if (/= 52 (getvar "ErrNo"))
(princ "\nNo object selected, please try again: ")
(progn
(princ "\nRight click detected - Terminate program. ")
(setq tstr nil)
)
)
(cond ((not (setq tstr (itoa (1+ (atoi tstr))))))
((eq ttag "NUMB") (*put* sel tstr '("NUMB")))
)
)
)
)
(*error* (princ "\nNothing selected. *INVALID*"))
)
)
-
... first i would like it to prompt the user for the attribute name so it would work universally instead of on a single block.
Dan,
The tool already prompts you to select a block. It could be modified to allow the user to select a block or input a block name. However to make it truely universal all your attributes would have have the same tagname.
secondly i would like to modify it so the user selects the attributes in the order they want and it numbers them all at once not with each pick. this last one is a request from my boss. any takers???
This could be done however I would like to know why, just curious? :)
-
will what i was trying to say is it would ask for the block name and attribute name so it could be used for any block. i agree that the second opiton is not neccesary but i think we have some other tools which behave this way so she is just used to it behaving that way. that's my guess anyway. any thoughts