Results 1 to 5 of 5

Thread: Need help with my lisp routine

  1. #1
    Login to Give a bone

    Default Need help with my lisp routine


    I am currently updating a lisp routine for work but I haven't been doing any lisp programming for a long time and I have a hard time to fix this one and wonder if anyone could help.

    The original routine was used to automatically ask to update the title block of our drawings unless the the block attribute "FRMDATE" was equal to Aug 15/2000.

    We just created a new set of title block and now want the routine to work the say way unless "FRMDATE" is equal to Aug 15/200 or Mar 31/2006.

    Here is the original lisp text
    ;                            AutoCad/AutoLisp
    ;   Purpose: To check for out of date formats
    ;   Note: Updates block definitions only...does not
    ;          re-insert block instances.  Therefore attributes
    ;          not re-created and could be in OLD locations if
    ;          moved in latest definition.
    ;   Rev.  Date:     By:  Description:   
    ;   1.00  Oct 09/00 PTD  -Acad2000 compliant.
    ;   1.10  Nov 09/00 PTD  -added check for formats without FRMRDATE
    ;                           attribute (old formats).
    ;   2.00  Mar 29/06 PTD  -added replacement of old versions with new series
    ;                           while not changing Aug 15/2000 versions
    ;   3.00  Aug 13/14 ML   -added replacement of old versions with new series
    ;                           while not changing Aug 15/2000 and Mar 31/2006 versions
    (defun c:APCfchk ( / ent1 ent2 date_str dcl_id dcl_act curtab srch count1 count2
                         found_date found_att std_frm repl_frm cvnum flag ssb
                         bname1 bname2 nbname srch blk_lst srgmode sattreq sosmode
                         bdata b_ent b_lay b_org b_x b_y b_ang b_attlst b_layout
      (setq date_str "Aug 15/2000"
            std_frm (list "FRM101H" "FRM102H" "FRM103H" "FRM104H" "FRM105H" "FRM106H"
                          "FRM107H" "FRM108H" "FRM109H" "FRM110H" "FRM111H"
                          "FRM121H" "FRM122H" "FRM123H" "FRM124H" "FRM125H"
            repl_frm(list "FRM127H" "FRM127H" "FRM128H" "FRM129H" "FRM130H" "FRM131H"
                          "FRM127H" "FRM128H" "FRM129H" "FRM130H" "FRM131H"
                          "FRM127H" "FRM128H" "FRM129H" "FRM130H" "FRM131H" 
            blk_lst (list "")
            srgmode (getvar "regenmode")
            flag nil
      (foreach bname1 std_frm
        (if (setq srch (tblsearch "BLOCK" bname1))
            (setq found_date 0
                  found_att 0
                  ent1 (dxf -2 srch)
            (while (setq ent1 (entnext ent1))
              (setq ent2 (entget ent1))
              (if (= (dxf 0 ent2) "ATTDEF")
                (if (= (dxf 2 ent2) "FRMRDATE")
                  (if (= (dxf 1 ent2) date_str)
                    (setq found_date 2)
                    (setq found_date 1)
                  );end if matched date
                  (setq found_att 1)
                );end if FRMRDATE
              );end if ATTDEF
            );end while
            (if (or (= (+ found_date found_att) 1)
                    (= (+ found_date found_att) 2)
              (progn;** formats need updating
                ;** cross-reference old to new formats
                (setq bname2 (nth (- (length std_frm)
                                     (length (member (strcase bname1) std_frm))
                (setq blk_lst (append blk_lst (list (list bname1 bname2))))
              );end progn
            );end if
          );end progn matched form block
        );end if
      );end foreach
        ;** Format Blocks Found
        ((> (length (setq blk_lst (cdr blk_lst))) 0)
            ;*** Modelspace current...NO Updates
            ((= (strcase (setq curtab (getvar "ctab"))) "MODEL")
              (alert (strcat "This Drawing contains Superceded Formats"
                             "\n     which must be Updated Manually")
            ;*** Paperpace current...ask to do Updates
              ;** Start of Dialog Box Stuff 
              (setq dcl_id (load_dialog "abb_util.dcl"));*** load dialog file
              (if (not (new_dialog "form_up" dcl_id))   ;*** check for dialog box
                (exit)                                  ;*** dialog box not found so exit 
              (action_tile "Yes" "(done_dialog 1)") 
              (action_tile "No" "(done_dialog 0)")
              ;** Start dialog box input
              (setq dcl_act (start_dialog))
              (unload_dialog dcl_id)
              (if (= dcl_act 1);** Do Updates
                  ;Switch to PSpace if in MSpace
                  (if (/= (setq cvnum (getvar "CVPORT")) 1)(command "pspace"))
                  (setvar "regenmode" 0)
                  ;** Cycle thru blocknames
                  (foreach nbname blk_lst
                      ;** Find instances of each blockname
                      ((setq ssb (ssget "X" (list (cons 0 "INSERT")
    ;                                              (cons 410 curtab)
                                                  (cons 2 (car nbname))
                                 );end ssget 
                        (setq count1 0
                              count2 0
                              insbname (strcat (cadr nbname) "=" (cadr nbname))
                        ;** Cycle thru each instance of a blockname and gather info
                        ;** to insert updated block in it's place
                        (repeat (sslength ssb)
                          (setq bdata (entget (setq b_ent (ssname ssb count1)))
                            b_lay (dxf 8 bdata)
                            b_org (dxf 10 bdata)
                            b_x (dxf 41 bdata)
                            b_y (dxf 42 bdata)
                            b_ang (cvunit (dxf 50 bdata) "radian" "degree")
                            b_attlst (get_attblk b_ent)
                            b_layout (dxf 410 bdata)
                          (if (= b_layout curtab)
                            ;**Update Blocks in current layout only
                              (entdel b_ent)
                              (setq sosmode (getvar "osmode")
                                    sattreq (getvar "attreq")
                                    count2 (1+ count2)
                              (setvar "attreq" 0)
                              (setvar "osmode" 0)
                              (command ".INSERT" insbname b_org b_x b_y b_ang)
                              (setq b_ent (entlast))
                              (command ".chprop" b_ent "" "LA" b_lay "")
                              (upd_attblk b_ent b_attlst)
                              (setvar "attreq" sattreq)
                              (setvar "osmode" sosmode)
                            );end progn
                          );end if
                          (setq count1 (1+ count1))
                        );end repeat
                        ;**Check for instance in other Layouts
                        (if (> (- (sslength ssb) count2)0)(setq flag T))
                      );end cond ssget block
                    );end cond
                    (setq ssb nil)
                  );end foreach
                  (command "regenall")
                  (setvar "regenmode" srgmode)
                  ;Switch back to MSpace if needed
                  (cond((/= cvnum 1)(command "mspace")(setvar "CVPORT" cvnum)))
                  (if flag (alert " Formats in Other Layouts\nmust be Updated Manually"))
                ) ;end progn
              );end if 
            );end T cond
          );end cond
        );format blocks found
      );end cond

    If someone could give me some advice, it would be really appreciated.


    Last edited by BlackBox; 2014-08-15 at 05:26 PM. Reason: Please use [CODE] Tags

  2. #2
    Programming Moderator BlackBox's Avatar
    Join Date
    Login to Give a bone

    Default Re: Need help with my lisp routine

    If you're creating a new set of title blocks, then I strongly advise you to implement title block attributes, with Fields mapped to a Sheet Set's custom Properties.

    "Potential has a shelf life." - Margaret Atwood
    AutoCAD, and Civil 3D Certified Professional | Autodesk Authorized Developer
    Sincpac C3D ~ Autodesk Exchange Apps

  3. #3
    Login to Give a bone

    Default Re: Need help with my lisp routine

    Thanks for your advice.

    I would still like to use this lisp program cause it give us a warning on the screen when we open old drawings with title blocks that are obsolete. (attribute "FRMDATE" not equal to Aug 15/2000 or Mar 31/2006)

    We just don't want that warning sign to show up when the attribute "FRMDATE" is equal to Aug 15/2000 or Mar 31/2006 and I was thinking there was probably a way to quickly modify the code.

    It's working fine right now with a single value (Aug 15/2000) for date_str but how can I assign an additional value (Mar 31/2006) ?

    Any idea ?

  4. #4
    100 Club
    Join Date
    Ontario, Canada
    Login to Give a bone

    Default Re: Need help with my lisp routine

    The simplest revision I can see would be to change

    (setq date_str "Aug 15/2000"

    (setq date_str (list "Aug 15/2000"  "Mar 31/2006")

    (if (= (dxf 1 ent2) date_str)

    (if (member (dxf 1 ent2) date_str)

  5. #5
    Login to Give a bone

    Default Re: Need help with my lisp routine

    Made the changes and everything works fine.

    Thank you so much !

Similar Threads

  1. Calling up LISP routine from within another LISP
    By jimmy_goodall in forum AutoLISP
    Replies: 4
    Last Post: 2013-08-21, 05:56 AM
    By ECASAOL350033 in forum AutoLISP
    Replies: 6
    Last Post: 2013-06-21, 01:13 AM
  3. Help with a lisp routine to add a 12" line to this routine
    By Orbytal.edge341183 in forum AutoLISP
    Replies: 3
    Last Post: 2012-11-14, 10:33 PM
  4. Combine three lisp routine into one routine.
    By BrianTFC in forum AutoLISP
    Replies: 1
    Last Post: 2012-02-08, 12:14 PM
  5. Replies: 9
    Last Post: 2012-01-21, 07:58 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts