topic Re: Script or lisp program for as-built drawing package in Visual LISP, AutoLISP and General Customization Forum

Script or lisp program for as-built drawing package

gv6823otG42ZL — Fri, 11 Nov 2022 14:51:30 GMT

I have attached a general DWG that contains the information that will be involved in what I am attempting to accomplish. I have tried to write lisp programs for each function and then combine them, but it seems to be too difficult.

The goal is to have a program that completes the following tasks for all DWG files within a specified folder.

The first part of the program will remove all the rev clouds on each drawing. All the rev clouds exist on the same layer.
The second part will remove the P.E stamp that is on each drawing.
The third part of the program will go into the title block and increment the revision number by 1 for each drawing.
The fourth part will take user defined information 1 time for the revision block and insert that information into the next available revision block for all drawings. If all 6 slots are filled within a drawing, the program will delete the first revision block, move all the revision blocks over one, and then copy a revision block over into the new slot, and update it with the new revision number as well as the user defined information.

Is there a script or lisp program to complete this for all specified drawings in a folder, or is it better to break each component up into smaller lisp programmed commands?

@Sea-Haven

@paullimapa

***THE POST HAS BEEN EDITED FOR CLARITY***

Re: Script or lisp program for as-built drawing package

paullimapa — Fri, 11 Nov 2022 18:29:40 GMT

This lisp routine ClnABd should take care of #1 & #2. You already have TBlock for #3

; ClnABd function erase stamp block and revision clouds from as-built dwgs (defun c:ClnABd (/ blkname cmdecho flg IsLayerLocked lyrname menuecho ss) ;;; Returns T if Locked ;;; nil if Unlocked or not found ;;; nil if lname is not a string ;;; https://www.theswamp.org/index.php?topic=888.0 (defun IsLayerLocked (lname / ent ) (if (and (=(type lname) 'STR)(setq ent (tblobjname "LAYER" lname))) (= 4 (logand 4 (cdr (assoc 70 (entget ent))))) ) ) ; end defun (setq blkname "Certification MN-Appd" cmdecho (getvar"cmdecho") lyrname "REV CURRENT" menuecho (getvar"menuecho") ) (setvar"cmdecho"0) ; setup environment (setvar"menuecho"0) (if(IsLayerLocked lyrname) ; check if layer is locked (progn (setq flg 1) ; note that layer is originally locked (command "_.Layer" "_Unlock" lyrname "") ; unlock layer ) (progn (setq flg 0) ; note that layer is originally unlocked ) ) (if(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname) (cons 8 lyrname) '(66 . 1))))(command"_.Erase"ss"")) ; erase stamp (if(setq ss (ssget "_X" (list (cons 0 "*POLYLINE") (cons 8 lyrname))))(command"_.Erase"ss"")) ; erase revision clouds (if(not(zerop flg))(command "_.Layer" "_Lock" lyrname "")) ; restore layer to original locked status (princ"\nClnABd function successfully completed.") (setvar"cmdecho"cmdecho) ; restore environment (setvar"menuecho"menuecho) (princ) ) ; defun (princ"\nClnABd successfully loaded.")(princ)

@Sea-Haven can provide his bump function for #4

Then the one line script file for #1, #2 & #3 to go with Lee's Script Writer routine http://www.lee-mac.com/scriptwriter.html would look something like:

(load"ClnABd") ClnABd (load"TBlock") TBlock _.Qsave _.Close

Re: Script or lisp program for as-built drawing package

Moshe-A — Sat, 12 Nov 2022 17:51:21 GMT

@gv6823otG42ZL hi,

check this AUTOMOD (Auto Modify) command but hey, do not rush 😀 read all the instructions first.

for your requests 1+2+3 the command answer them very easily. request 4 was not easy challenge. in order it to work you need to specify the user defined information for revattr block, so this is implement as a lsp file which it content is like this:

(setq newRevData

'( ("revno" . "") ; place holder
("date" . "6-10")
("revision1" . "revision1")
("revision2" . "revision2")
("revision3" . "revision3")
("revby" . "revby")
("appdby" . "appdby")
); list
); setq

first open notepad than copy & paste this content in and save it in your document folder by the name of revdata.lsp you can save it with any name you like as long it's type must be lsp. (remember that name)

the data format is a list of dotted pairs items. each item holds 2 data strings, the first is TAG name and the second is the tag VALUE. the 2 strings are separate by dot "." (that's what dotted pairs means) you need to fill only the second data strings with the new revattr info. make sure you do not mess the format every character is important here. each data string must start and end with double apostrophe. the first dot pair ("revno" . "") is just place holder do not fill or delete it.

in your script program you need to load revdata.lsp along with automod.lsp each drawing you open.

the command starts with defining some constant variables, i'm talking about your blocks names the title block the P.E block, revattr block and the layer "rev current".

; define const for blocks name (setq TITLEBLK "tad15") (setq PEBLK "Certification MN-Appd") (setq REVBLK "revattr") ; const for revision layer (setq REVLAY "rev current") ; get attribute tag from block definition (setq TAGS (get_attrib_def))

if in future you need to change these names, you can easily change them here and the command will still work.

also there is a TAGS variable which holds a list of tags name. these tag name is read directly from the block (revattr) definition. in future if you decide to add more attribute or change some, automod will read these changes and still work. note that you will have to sync these change with the content (tag names) in revdata.lsp.

now for the script:

two weeks ago a member of this forum ask about scripts i suggest you to look at it >> HERE << message #6 of 11

also look at @paullimapa advice on how to create the script.

enjoy

Moshe

(vl-load-com) ; load ActiveX support ; auto modifications (defun c:automod (/ _dat get_attrib_def getAttribValue setAttribValue process_data ; local functions upadte_revision_data shift_attribute_data update_revision_blocks ; local functions TITLEBLK PEBLK REVBLK REVLAY TAGS ss ent rev data^) ; anonymous function (setq _dat (lambda () (mapcar (function (lambda (d) (cdr d))) newRevData))) (defun get_attrib_def (/ blocks lst) (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for AcDbEntity (vla-item blocks REVBLK) (if (eq (vla-get-objectName AcDbEntity) "AcDbAttributeDefinition") (setq lst (cons (vla-get-tagString AcDbEntity) lst)) ) (vlax-release-object AcDbEntity) ); vlax-for (vlax-release-object blocks) (reverse lst) ); get_attrib_def (defun getAttribValue (ent tag / val) (if (not (vl-catch-all-error-p (setq val (vl-catch-all-apply 'getPropertyValue (list ent tag))) ) ); not val ); if ); getAttribValue (defun setAttribValue (ent tag val) (not (vl-catch-all-error-p (vl-catch-all-apply 'setPropertyValue (list ent tag val)) ) ); not ); setAttribValue (defun process_data () (vl-sort (mapcar (function (lambda (ename / lst) (reverse (cons ename (foreach tag TAGS (setq lst (cons (getAttribValue ename tag) lst)) ) ); cons ); reverse ); lambda ); function (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ); mapcar (function (lambda (e0 e1) (< (car e0) (car e1)))) ); vl-sort ); process_data (defun upadte_revision_data (/ _nrd _fnd ; local function orec nrec) ; anonymous functions (setq _nrd (lambda () (mapcar (function (lambda (tag dat) (cons tag (cdr dat)))) TAGS newRevData))) (setq _fnd (lambda () (vl-some (function (lambda (rev) (if (eq (cadr rev) "") rev))) data^))) (if (setq orec (_fnd)) (progn (setq nrec (cons (car orec) (append (cdr (_dat)) (list (last orec))))) (foreach dotpair (subst (cons "revno" (car orec)) (assoc "revno" (_nrd)) (_nrd)) (setAttribValue (last orec) (car dotpair) (cdr dotpair)) ) (setq data^ (subst nrec orec data^)) ); progn ); if ); upadte_revision_data (defun shift_attribute_data () (reverse (append (list (cons (itoa (1+ (atoi (car (last data^))))) (append (cdr (_dat)) (list (last (last data^)))))) (mapcar (function (lambda (e0 e1) (append (reverse (cdr (reverse e0))) (list (last e1))) ); lambda ); function (reverse (cdr data^)) (cdr (reverse data^)) ); mapcar ); append ); reverse ); shift_attribute_data (defun update_revision_blocks () (vl-every (function (lambda (rev) (vl-every (function (lambda (tag val) (setAttribValue (last rev) tag val) ) ); function TAGS rev ); vl-every ); lambda ); function data^ ); vl-every ); update_revision_blocks ; here start (c:automod) ; define const for blocks name (setq TITLEBLK "tad15") (setq PEBLK "Certification MN-Appd") (setq REVBLK "revattr") ; const for revision layer (setq REVLAY "rev current") ; get attribute tag from block definition (setq TAGS (get_attrib_def)) ; 1 + 2 - delete rev clouds + P.E stamp (if (setq ss (ssget "_X" (list '(-4 . "<OR") '(-4 . "<AND") '(0 . "lwpolyline") (cons '8 REVLAY) '(-4 . "AND>") '(-4 . "<AND") '(0 . "insert") (cons '8 REVLAY) (cons 2 PEBLK) '(66 . 1) '(-4 . "AND>") '(-4 . "OR>") ); list ); ssget ); setq (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel ent) ; delete revision clouds ) ); if ; 3 - increment revision cloud (if (setq ss (ssget "_X" (list '(0 . "insert") (cons '2 TITLEBLK) '(66 . 1)))) (progn (setq ent (ssname ss 0)) (if (setq rev (getAttribValue ent "rev")) (setattribValue ent "rev" (itoa (1+ (atoi rev)))) ) ; 4 - insert revision data (if (setq ss (ssget "_X" (list '(0 . "insert") (cons '2 REVBLK)))) ; select revision slots (progn (setq data^ (process_data)) (if (not (upadte_revision_data)) ; revision slots is full (setq data^ (shift_attribute_data)) ); if (update_revision_blocks) ); progn ); if ); progn ); if (princ) ); c:automod

Re: Script or lisp program for as-built drawing package

Moshe-A — Sun, 13 Nov 2022 06:24:12 GMT

@gv6823otG42ZL

Good Morning,

wrapped all in files. save revdata.lsp in your documents folder or any other folder that is in the support files path.

Moshe

Re: Script or lisp program for as-built drawing package

Sea-Haven — Sun, 13 Nov 2022 06:31:35 GMT

You can write a script that runs each program one after another that way can check all working, can then join into 1 big program and if each step is a seperate defun just call them again in correct order.

I will look into does rev 6 have details and now need rev 7 for the rev bump, it will remove rev 1 and redo them all adding 7 etc. It has to be custom done to suit your dwg. making all revs part of the primary title block is easier.

Re: Script or lisp program for as-built drawing package

Moshe-A — Sun, 13 Nov 2022 22:17:50 GMT

@gv6823otG42ZL ,

Since you did not reply, i assumed you still have difficulty to put all things together so here you have it all. attached zip file contain automod.lsp (did some fine tuning) + revdata.lsp + automod.scr. save these files in your document folder.

open automod.scr file in notepad, spot the lines starting with open? replace the file name with your files to be modify (see above how to copy and paste the a list of full path name from a folder).

what the script does is open the dwg, load automod.lsp, run the automod command, qsave and exit...handle next dwg

open "c:\projects\jonny walker\plans\p0.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p1.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p2.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p3.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p4.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p5.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p6.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p7.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p8.dwg" (load "automod") automod qsave quit y open "c:\projects\jonny walker\plans\p9.dwg" (load "automod") automod qsave quit y

now for the last part, running the script

on your desktop copy & paste an AutoCAD XXXX shortcut, right click it and select properties. enter Start in and at end of the field (text) add /b automod

this tell AutoCAD to run the script file.

that's it job complete 😀

Moshe

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Sun, 13 Nov 2022 22:21:14 GMT

Thank you !! I will report back in a couple days once I can try this out and see what happens !

Re: Script or lisp program for as-built drawing package

pbejse — Wed, 16 Nov 2022 04:55:16 GMT

@gv6823otG42ZL wrote:

The first part of the program will remove all the rev clouds on each drawing. All the rev clouds exist on the same layer.

The second ....

(defun c:NotInvited ( / _string _AttFunc aDoc _PutRev carCadr itIsAblock newRevData _date revNum _RevBy _ApvBy revVal revBlock bname objType titleBlockData itIsAblock ) (defun _string (msg m / r) (if (and (setq r (getstring t (Strcat "\n" msg m ": "))) (/= r "")) r ) ) (defun _AttFunc (en lst / vals v) (mapcar (function (lambda (at) (setq vals (list (vla-get-tagstring at)(vla-get-textstring at) at)) (if (and lst (setq v (assoc (car vals) lst))) (vla-put-textstring at (cadr v)) ) vals)) (vlax-invoke (if (eq (type en) 'VLA-OBJECT) en (vlax-ename->vla-object en)) 'Getattributes) ) ) (defun _PutRev (lst ls / f) (foreach itm lst (and (setq f (assoc (car itm) ls)) (vla-put-textstring (caddr f) (Cadr itm)) ) ) ) (setq n 0 _num (lambda (x)(atoi (cadr (assoc "REVNO" x)))) carCadr (lambda (n)(list (car n)(cadr n)))) (if (and (setq _date (_string "Enter Date <M-YY>" "")) (setq _RevBy (_string "Reviewed by" "")) (setq _ApvBy (_string "Approved by" "")) (progn (while (and (< n 3) (setq rev (_string "Description Line " (itoa (setq n (1+ n)))))) (setq revVal (Cons (list (strcat "REVISION" (itoa n)) rev) revVal)) ) revVal ) ) (progn (setq newRevData (append revVal (mapcar 'list '("DATE" "REVBY" "APPDBY") (list _date _RevBy _ApvBy)))) (vlax-for itms (Vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object ))) (setq objType (vlax-get itms 'ObjectName)) (cond ((not (vlax-write-enabled-p itms)) ) ((or (and (setq itIsAblock (eq "AcDbBlockReference" objType)) (eq (setq bname (strcase (vla-get-EffectiveName itms))) "CERTIFICATION MN-APPD") ) (and (eq (vla-get-layer itms) "REV CURRENT") (eq "AcDbPolyline" objType)) ) (vla-delete itms) ) ((and itIsAblock (eq "TAD15" bname)) (setq titleBlockData (_AttFunc itms nil)) ) ((and itIsAblock (eq "REVATTR" bname)) (setq revBlock (cons (_AttFunc itms nil) revBlock)) ) ) ) (and (setq inc -1 revBlock (vl-sort revBlock '(lambda (a b) (> (_num a) (_num b))))) (or (vl-some (function (lambda ( cd ) (setq inc (1+ inc))(/= (cadr (assoc "DATE" cd)) ""))) revBlock) inc) (setq revNum (cadr (assoc "REVNO" (car revBlock)))) (cond ((zerop inc) (foreach itm '("REVISION1" "REVISION2" "REVISION3") (vla-put-textstring (caddr (assoc itm (car revBlock))) "")) (mapcar '(lambda ( j k) (_PutRev j k)) (cons (cons (list "REVNO" (setq revNum (itoa (1+ (atoi revNum))))) newRevData) (mapcar '(lambda (d) (mapcar 'carCadr d)) revBlock) ) revBlock ) ) ((setq newRev (nth (1- inc) revBlock)) (_PutRev newRevData newRev) ) ) ) (and titleBlockData (_PutRev (mapcar 'list '("DATE" "REV")(list _date revNum)) titleBlockData)) ) ) (princ) )

HTH

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Thu, 17 Nov 2022 20:30:04 GMT

Here is the error that i have been getting. The script is listed in that directory. Any ideas what's going on?

Re: Script or lisp program for as-built drawing package

Moshe-A — Sun, 20 Nov 2022 15:14:24 GMT

@gv6823otG42ZL ,

Add at least one space where you add => /b automod

the system is complaining about an invalid folder.

Moshe

Re: Script or lisp program for as-built drawing package

Sea-Haven — Sun, 20 Nov 2022 23:32:16 GMT

To do the update revs past 6 I have redone the revision block to be one block, I need to know if happy with that concept as its the easiest way to update the revs. Finding the revs as single blocks at any scale could be difficult, the current blocks are at a scale of 40.666 should be 40.0 ?

Please have a look at this block paste into a dwg, you may need to rescale.

Re: Script or lisp program for as-built drawing package

Moshe-A — Wed, 23 Nov 2022 07:24:18 GMT

@gv6823otG42ZL .

@gv6823otG42ZL wrote:
Thank you !! I will report back in a couple days once I can try this out and see what happens !

couple days are over? 😀

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Tue, 29 Nov 2022 13:18:11 GMT

I have added the space at /b automod and it is still giving me the same error as above. The files are located within that folder as well. Any ideas?

Re: Script or lisp program for as-built drawing package

Moshe-A — Tue, 29 Nov 2022 13:31:25 GMT

@gv6823otG42ZL

opps realy sorry

add the /b automod to the end of target field

Re: Script or lisp program for as-built drawing package

Kent1Cooper — Tue, 29 Nov 2022 13:40:03 GMT

@gv6823otG42ZL wrote:
....

The first part of the program will remove all the rev clouds on each drawing. All the rev clouds exist on the same layer.

The second part will remove the P.E stamp that is on each drawing. ....

For those, would a simple LAYDEL, or perhaps just Freezing the Layers, suffice?

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Tue, 29 Nov 2022 13:46:52 GMT

The LAYDEL would work for the p.e stamp. The LAYDEL wouldn’t work for the revision clouds because sometimes there are multiple rev clouds from multiple work orders on one drawing. What would work better is to remove any objects that have a color number 243 assigned to them. This deletes the current rev clouds that are on the drawing but won’t delete any rev clouds that exist on that layer for other work orders.

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Wed, 30 Nov 2022 16:48:44 GMT

That works, as long as the rev number can be modified on its own still if need be

Re: Script or lisp program for as-built drawing package

nick.baileyVASY9 — Wed, 30 Nov 2022 17:12:21 GMT

@paullimapa What is TBlock? How do I get it?

~nic

Re: Script or lisp program for as-built drawing package

paullimapa — Wed, 30 Nov 2022 21:01:08 GMT

I coded that for the OP in another thread but here it is for you:

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/use-a-lisp-program-to-identify-the-revision-number-within-a/m-p/11544838#M439286 (defun c:TBLOCK (/ blkname chg en i sed sen ss tagname txt) (setq blkname "Tid22" chg 0 tagname "REV") (if(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname) '(66 . 1)))) (progn (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i)))) (setq sen (entnext en)) ; get attributes (while sen (setq sed (entget sen)) (if (/= (cdr(assoc 0 sed)) "SEQEND") (if(eq tagname (cdr(assoc 2 (entget sen)))) (progn (setq txt(getpropertyvalue sen "TextString")) ; get current value (setq txt(itoa(1+ (atoi txt)))) ; increase # by 1 (setpropertyvalue sen "TextString" txt) ; set updated value (setq sen nil chg (1+ chg)) ) ; progn (setq sen (entnext sen)) ) ; if found tag (setq sen nil) ) ; if more attributes ) ; while attributes ) ; repeat (princ(strcat"\nTotal of [" (itoa chg) "] [" blkname "] Blocks with Tag [" tagname "] Updated.")) ) ; progn (princ"\nNo Matching Block Objects Found.") ) ; if (princ) ) ; defun

Re: Script or lisp program for as-built drawing package

gv6823otG42ZL — Wed, 30 Nov 2022 20:58:54 GMT

Hi all! I have decided to write these different lisp commands and then attempt to combine them all in a script that can be applied to all the drawings. The last lisp command is attempting to update the rev blocks for each drawing. Just wanted to check and see if there are any ideas. I would like the command to take user defined information once and apply that information to all the other drawings besides the rev number. The rev number will increment to the next available rev number. But if all 6 slots are filled, the rightmost rev block will be deleted, then all the rev blocks will be shifted one slot over. Then a new rev block will be put into the next available slot and updated with the user defined information as well as the new revision number. If this doesn't make sense, I can attempt to provide an example. I know this is complicated so any ideas on how to go forward with this would be great

@paullimapa @Moshe-A @Sea-Haven @Kent1Cooper @nick.baileyVASY9