Results 1 to 2 of 2

Thread: update title block in multiple tabs

  1. #1
    Member
    Join Date
    2001-12
    Posts
    2
    Login to Give a bone
    0

    Default update title block in multiple tabs

    Hi, I am trying to run the attached routine across multiple tabs within files. It works fin on the active tab if drag n drop but needs more coding than i recall at short notice. Block 'test' can have anything in it but have attached sample. (well trying to figure how to anyway)
    Assistance appreciated. Cheers, Peter

    $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    (defun REINS (/ A ANGLE1 B C D E ED ENT f G H INSP LAY NED NENT
    NTAG NTYPE SCMDE TAG TYPE X Y Z)
    (command ".-layer" "th" "0" "on" "0" "s" "0" "")
    (setq SCMDE (getvar "CMDECHO"))
    (setvar "CMDECHO" 0)
    (SETVAR "ATTDIA" 0)
    (command "regenauto" "off" "._LAYER" "M" "REIN" "")
    ;;(setq SSET1 (ssget (list (cons 0 "INSERT"))))
    (setq SSET1 (ssget "x" (list (cons 2 "CA00_MR_A1_Att"))))
    ;;(setq SSET1 (ssget "x" (list (cons 2 "test"))))
    (setq CNT9 0)
    (repeat (sslength SSET1)
    (setq ENAM (ssname SSET1 CNT9)
    ELST (entget ENAM)
    BLKNAM1 (cdr (assoc 2 ELST))
    CNT9 (1+ CNT9)
    )
    (reins2)
    )
    )
    (defun REINS2 ()
    (setq BLKNAM (strcat BLKNAM1 "="))
    (princ "\n")
    (princ BLKNAM)
    (setq SSET (ssget "x" (list (cons 2 BLKNAM1))))
    (setq A 0)
    (setq B 1)
    (setq C 0)
    (while (= C 0)
    (setq ENT (ssname SSET A))
    (if (= ENT nil)(setq c 1)
    (progn
    (setq ED (entget ENT))
    (setq NENT (entnext ENT))
    (setq NED (entget NENT))
    (setq NTYPE (cdr (assoc 0 NED)))
    (if (= NTYPE "ATTRIB")(setq B 0)(setq NENT nil))
    (setq LAY (CDR (assoc 8 ed)))
    (setq X (rtos (car (cdr (assoc 10 ED))) 2 4))
    (setq Y (rtos (car (cdr (cdr (assoc 10 ED)))) 2 4))
    (setq Z (rtos (car (cdr (cdr (cdr (assoc 10 ED))))) 2 4))
    (setq INSP (cdr (assoc 10 ED)))
    (setq SCALEX (cdr (assoc 41 ED)))
    (setq SCALEY (cdr (assoc 42 ED)))
    (setq SCALEZ (cdr (assoc 43 ED)))
    (setq ANGLE1 (* 180 (/ (cdr (assoc 50 ED)) pi)))
    (setq f (open "REINSERT.TXT" "a"))
    (setq D 0)
    (while (= B 0)
    (if (= NENT nil)(setq B 1)
    (progn
    (setq NAME (cdr (assoc 1 NED)))
    (setq TAG (cdr (assoc 2 NED)))
    (write-line TAG f)
    (write-line NAME f)
    (setq NENT (entnext NENT))
    (setq NED (entget NENT))
    (setq D (+ D 1))
    (setq TYPE1 (cdr (assoc 0 NED)))
    (if (= TYPE1 "SEQEND")(setq B 1))
    )
    )
    )
    (close f)
    (command "INSERT" BLKNAM INSP SCALEX SCALEY ANGLE1)
    (while (= (getvar "cmdactive") 1)(command ""))
    (setq ENT (entlast))
    ; (command "point" "0,0")
    (setq ED (entget ENT))
    (setq NENT (entnext ENT))
    (setq NED (entget NENT))
    (setq NTYPE (cdr (assoc 0 NED)))
    (if (= NTYPE "ATTRIB")(setq E 0)(setq E 1))
    (while (= E 0)
    (if (= NENT nil)(setq E 1)
    (progn
    (setq G 0)
    (setq H 0)
    (setq NTAG (cdr (assoc 2 NED)))
    (setq f (open "reinsert.txt" "r"))
    (while (= G 0)
    (setq TAG (read-line f))
    (setq NAME (read-line f))
    (if (= TAG NTAG)
    (progn
    (setq NED (subst (cons 1 NAME) (assoc 1 NED) NED))
    (entmod NED)
    (setq G 1)
    )
    )
    (setq H (+ H 1))
    (if (= D 0)(setq G 1))
    (if (= H D)(setq G 1))
    )
    (close f)
    (setq NENT (entnext NENT))
    (setq NED (entget NENT))
    (setq TYPE1 (cdr (assoc 0 NED)))
    (if (= TYPE1 "SEQEND")(setq E 1))
    )
    )
    )
    (setq ED (subst (cons 8 LAY) (assoc 8 ED) ED))
    (entmod ED)
    (setq f (open "REINSERT.TXT" "w"))
    (close f)
    (setq A (+ A 1))
    )
    )
    )
    (command "ERASE" "P" "" "redraw" "._LAYER" "S" "0" "")
    (setq SSET (ssget "x" (list (cons 0 "POINT")(cons 8 "REIN"))))
    ; (SETVAR "LUNITS" 4)
    (setvar "CMDECHO" SCMDE)
    ; (command "ERASE" "P" "" "REGENAUTO" "ON")
    )
    (REINS)

  2. #2
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Chelan WA
    Posts
    1,069
    Login to Give a bone
    0

    Default Re: update title block in multiple tabs

    I wrote that code (above) a LONG time ago, before we had attsync.

    Try this.

    Code:
    (defun C:UPDATE (/
                       objSelection
                       ssSelections
                       strBlockName
                       strFileName
                    )
     (princ "\nSelect Block to be updated: ")
     (if (and (setq ssSelections (ssget ":E:S" (list (cons 0 "insert"))))
              (setq objSelection (vlax-ename->vla-object 
                                  (ssname ssSelections 0)))
              (setq strBlockName (vla-get-effectivename objSelection))
              (setq strFileName  (strcat strBlockName ".dwg"))
              (findfile strFileName)
         )
      (progn
       (command "-insert" (strcat strBlockName "=") "0,0")
       (while (= (getvar "cmdactive") 1)
        (command "")
       )
       (entdel (entlast))
       (command "attsync" "N" strBlockName)
      )
      (princ "\nError: ")
     )
     (prin1)
    )
    AutomateCAD

Similar Threads

  1. Update Title Block Lisp Problem
    By stusic in forum AutoLISP
    Replies: 13
    Last Post: 2015-05-28, 04:21 PM
  2. Update Title Block data in numerous drawing files
    By rer2003mcbs.66431 in forum AutoLISP
    Replies: 3
    Last Post: 2007-05-29, 01:58 PM
  3. Update Block Definition is multiple files.
    By dhendrickson in forum AutoCAD General
    Replies: 2
    Last Post: 2007-01-25, 05:56 PM
  4. Convert MDT Title Block to Inventor 10 Title Block
    By julesgordon in forum Inventor - General
    Replies: 1
    Last Post: 2005-07-18, 08:34 PM
  5. Replies: 9
    Last Post: 2005-01-25, 02:31 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
  •