Lot Numbering

Code Red > AutoLISP (Vanilla / Visual)

Lot Numbering

(1/3) > >>

DanB:
I was hoping I could get some help with modifying an existing LISP routine or at least use the same concept. I just started a new job so I don't have all my reference materials and old lisps to refer to here yet. We have a routine that will place sequential text numbering to label lots in a subdivision. What we would prefer to do is use a block with an attribute in place of just text. The block name is "lotnumber", scale based on the drawing, and the rotation will probably be a constant (zero, 90). As always, thanks for any advise or guidance with this. It's been awhile since I've been able to browse here again and with the new job keeping me busy not sure how much I'll get to stop in.

Thanks Again,
Dan

Code:

--- Code: ---
(defun lotn ( / p p1 p2 n1 scmde)
(setq n1 (getint "Enter starting lot number: "))
(setq p1 (getpoint "\nText location: "))
(setq scmde (getvar "cmdecho"))
(while p1
(setvar "cmdecho" 0)
(setq p2 p1)
(if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
(command "text"
"J"
"MC"
(setq p p1)
(setq p "")
(setq p "")
(setq p n1)
)
(command "text"
"J"
"MC"
(setq p p1)
(setq p "")
(setq p n1)
)
);if
(setq n1 (+ n1 1))
(setq p1 (getpoint "\nText location: "))
(if (= p1 p2) (setq p1 nil))
)
(setvar "cmdecho" scmde)
(princ)
)
(defun C:LOTNO ()
(lotn)
)
(princ "Type LOTNO to begin.")
(princ)
--- End code ---

Mark:
If you're not in a big hurry(couple days) I can modify one that will work for you.

Just curious though, why a block?

PS. do you use land desktop ?

DanB:
Yes, we are using LDD 2004.

Jeff_M:
Here's one I use to label Tentative Maps and Assessor Plats. Actually I modified the one I use to use a block in place of text....

The thing I like best is it will "remember" from one use to the next, in the same drawing, which number it is on. Very handy for those pesky interruptions or when the client says "I just tied up the parcel next door, let's add it to this project", etc.

Uses functions created by Jurg Menzi for working with Dictionaries.

--- Code: ---
;;;;begin code by Jeff Mishler to insert
;;;;a number and increment the value to insert
;;;;the next number

(defun c:lotnum (/ new_num blk)
(if (and (not (tblsearch "block" "lotnumber"))
(not (setq blk (findfile "lotnumber.dwg")))
)
(alert (strcat "Routine requires attributed block \"Lotnumber\" and I could not find it."
"\nPlease make this block available and try again...."))
(progn
(createDict "jmm_Number")
(if (not (setq recList (getDictRec "jmm_Number" "last_num")))
(progn
(addDictRec "jmm_Number" "last_num" (list (cons 76 1)))
(setq recList (getDictRec "jmm_Number" "last_num"))
)
)
(if (not *last_num*)(setq *last_num* (cdr (car reclist))))
(cond
((setq new_num (getint (strcat "\nNumber to start numbering with ("
(itoa *last_num*)
") : ")))(start_lbl))
((setq new_num *last_num*)(start_lbl))
)
(princ)
)
)
)
(defun start_lbl (/ INSPT SCL)
(setq scl (getvar "dimscale"))
(while (setq insPt (getpoint "\nSelect next number Insertion Point: "))
(command "-insert" "lotnumber" inspt scl scl 0.0 new_num)
(setq new_num (1+ new_num)
*last_num* new_num
)
(chgDictRec "jmm_Number" "last_num" (list (cons 76 *last_num*)))
)
)
;The following Dictionary functions are as posted to the
;Autodesk customization newsgroup by Juerg Menzi...he
;mentions that the origin is unknown.....
;
; -- Function CreateDict
; Creates a new or returns an existing dictionary.
; Arguments [Typ]:
; Nme = Name of the new dictionary [STR]
; Return [Typ]:
; > Entity name of new/existing dictionary [ENAME]
; Notes:
; None
;
(defun CreateDict (Nme / DicEnt NewDic TmpLst)
(if (not (setq NewDic (GetDictEnt Nme)))
(setq TmpLst '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
DicEnt (entmakex TmpLst)
NewDic (dictadd (namedobjdict) Nme DicEnt)
)
NewDic
)
)
;
; -- Function DelDict
; Deletes the specified dictionary.
; Arguments [Typ]:
; Nme = Name of the dictionary to delete [STR]
; Return [Typ]:
; > Entity name [ENAME]
; Notes:
; None
;
(defun DelDict (Nme)
(dictremove (namedobjdict) Nme)
)
;
; -- Function AddDictRec
; Adds a record to a dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Key = Keyname for the record object [STR]
; Lst = Data list '((Key1 . Value1)...(Keyx . Valuex)) [LIST]
; Return [Typ]:
; > Entity name of modified dictionary [ENAME]
; Notes:
; None
;
(defun AddDictRec (Nme Key Lst / DicEnt TmpLst)
(setq TmpLst (append
'((0 . "XRECORD") (100 . "AcDbXrecord") (280 . 0))
Lst
)
DicEnt (entmakex TmpLst)
)
(dictadd (GetDictEnt Nme) Key DicEnt)
)
;
; -- Function GetDictRec
; Retrieves the data list by key from a dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Key = Keyname for the record object [STR]
; Return [Typ]:
; > Data list [LIST]
; Notes:
; None
;
(defun GetDictRec (Nme Key)
(cdr (cddddr (cddddr (dictsearch (GetDictEnt Nme) Key))))
)
;
; -- Function ChgDictRec
; Redefines the specified record of a dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Key = Keyname for the record object [STR]
; Lst = Data list '((Key1 . Value1)...(Keyx . Valuex)) [LIST]
; Return [Typ]:
; > Entity name of modified dictionary [ENAME]
; Notes:
; None
;
(defun ChgDictRec (Nme Key Lst)
(if (GetDictRec Nme Key)
(progn
(DelDictRec Nme Key)
(AddDictRec Nme Key Lst)
)
)
)
;
; -- Function DelDictRec
; Deletes the specified record from a dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Key = Keyname for the record object [STR]
; Return [Typ]:
; > Entity name of modified dictionary [ENAME]
; Notes:
; None
;
(defun DelDictRec (Nme Key)
(dictremove (GetDictEnt Nme) Key)
)
;
; -- Function GetDictKeys
; Returns a list of keynames from the specified dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Key = Keyname for the record object [STR]
; Return [Typ]:
; > Key list [LIST]
; Notes:
; None
;
(defun GetDictKeys (Nme / TmpLst)
(cond
((setq TmpLst (GetDict Nme)) (GetMassoc 3 TmpLst))
(T nil)
)
)
;
; -- Function GetDictKeysVals
; Returns a list of keynames with associated values from the
; specified dictionary.
; Arguments [Typ]:
; Nme = Name of dictionary to access [STR]
; Return [Typ]:
; > Key value list '((Key1 . Value1)...(Keyx . Valuex)) [LIST]
; Notes:
; None
;
(defun GetDictKeyVals (Nme)
(mapcar
'(lambda (l)
(cons l (cdar (GetDictRec Nme l)))
) (GetDictKeys Nme)
)
)
;
; -- Function ListDicts
; Returns a list of all dictionaries in the current drawing.
; Arguments [Typ]:
; --- =
; Return [Typ]:
; > List of dictionaries [LIST]
; Notes:
; None
;
(defun ListDicts ()
(GetMassoc 3 (entget (namedobjdict)))
)
;
; -- Function GetDict
; Retrieves the entity definition list of the specified dictionary.
; Arguments [Typ]:
; Nme = Name of the dictionary [STR]
; Return [Typ]:
; > Entity definition of dictionary [LIST]
; Notes:
; None
;
(defun GetDict (Nme)
(dictsearch (namedobjdict) Nme)
)
;
; -- Function GetDictEnt
; Retrieves the entity name of the specified dictionary.
; Arguments [Typ]:
; Nme = Name of the dictionary [STR]
; Return [Typ]:
; > Entity name of dictionary [ENAME]
; Notes:
; None
;
(defun GetDictEnt (Nme / TmpLst)
(cond
((setq TmpLst (GetDict Nme)) (GetAssoc -1 TmpLst))
(T nil)
)
)
;
; -- Function GetMassoc
; Get multiple associative values from a list.
; Arguments [Typ]:
; Key = Key to search [INT]
; Lst = Dotted pair list [LIST]
; Return [Typ]:
; > List of values [LIST]
; Notes:
; Published by T.Tanzillo
;
(defun GetMassoc (Key Lst)
(apply 'append
(mapcar
'(lambda (l) (if (eq (car l) Key) (list (cdr l)))) Lst
)
)
)
;
; -- Function GetAssoc
; Get associative value from a list.
; Arguments [Typ]:
; Key = Key to search [INT]
; Lst = Dotted pair list [LIST]
; Return [Typ]:
; > Value [ALL]
; Notes:
; None
;
(defun GetAssoc (Key Lst)
(cdr (assoc Key Lst))
)

--- End code ---
[/code]

DanB:
This is great at first glance. Is there a way to specify the direct path to the block we use? I'm not sure I understand how the findfile line works. The block is located on our network, so if I could give a direct path and not have to pre-define the block in the drawing that would be even better. Thanks again we are very excited about having this already. BIG time saver!

Dan

Navigation

[0] Message Index

[#] Next page

Go to full version