Jump to content

Sequentially number text in block attribute.


cadsultant

Recommended Posts

I would like to modify the lisp routine below to suit my need. It currently sequentially numbers text. But I would like to be able to number block attributes instead. Also I would like to specify how many digits. I have an attribute which consists of a callout bubble, and an attribute which I want updated. Please help. Thanks.

 

(defun *error* (MSG)

(princ MSG)

(princ "\nFunction cancelled")

(princ)

)

(prompt "\nLoading SEQN...")

(defun C:SEQN (/ SEQN ENT)

(if (not *SEQN) (setq *SEQN 1)) ;set default

(setvar "cmdecho" 0)

(princ "\nStarting Number

(princ *SEQN)

(setq SEQN (getint ">: "))

(if (not SEQN)

(setq SEQN *SEQN)

(setq *SEQN SEQN)

)

(graphscr)

(setq

ENT (entget

(car

(entsel

"\nSelect Text to Sequentially Number: "

)

)

)

)

(while ENT

(progn

(if (= (cdr (assoc 0 ENT)) "TEXT")

(progn

(entmod

(subst

(cons 1 (itoa SEQN))

(assoc 1 ENT)

ENT

)

)

(setq SEQN (1+ SEQN)) ;advance default

)

(princ "\nEntity must be TEXT")

)

(princ "\n")

(princ SEQN)

(setq

ENT (entget (car (entsel " - Select Text: ")))

)

) ;end progn

(setq *SEQN (1+ SEQN)) ;set for next use

) ;end if (princ)

) ;end seqn.lsp

Link to comment
Share on other sites

I would like to modify the lisp routine below to suit my need.

It currently sequentially numbers text. But I would like to be

able to number block attributes instead. Also I would like to

specify how many digits. I have an attribute which consists of

a callout bubble, and an attribute which I want updated.

Please help. Thanks.

Hi cadsultant

I changed slightly this routine,

please give it a try (tested in A2005 only)

 

    
(defun *error* (msg) 
(princ msg) 
(princ "\nFunction cancelled") 
(princ) 
) 
(prompt "\nLoading SEQN...") 
(defun C:SQA (/ *seqn atd atq en ent seqn sset)     
(setq atd (getvar "attdia")) 
(setq atq (getvar "attreq"))
(setvar "attdia" 0)
(setvar "attreq" 0)
(setvar "cmdecho" 0) 
(princ "\nStarting Number < ") 
(princ *seqn) 
(setq seqn (getint "> : ")) 
(if (not seqn) 
(setq seqn *seqn) 
(setq *seqn seqn) 
)

(while 
(if (setq sset (ssget "_:S" (list (cons 0 "INSERT");|(cons 2 block_name)|;(cons 66 1))))
   (progn
     (setq ent (ssname sset 0)
       en (entnext ent)
     )    
(while (= "ATTRIB" (cdr (assoc 0 (entget en))))
         (entmod (subst (cons 1 (itoa seqn))
                (assoc 1 (entget en)) (entget en))) 
         (setq en (entnext en))
         )

       (entupd ent)
     )

)
(setq seqn (1+ seqn))
)
(command "regen")
(setvar "attdia" atd)
(setvar "attreq" atq)
(setvar "cmdecho" 1)
(princ)
)

~'J'~

Link to comment
Share on other sites

must learn to type (or debug) faster..... :roll:

 

I have just done this VBA routine. Very basic and relies on "On Error resume next" to exit :cry: but sort of works - PROVIDING there is only one attribute in your block. Call it with "VBASTMT" "IncAtt"

 


Public Sub IncAtt()
Dim myEntity As AcadObject
Dim basePnt(0 To 2) As Double
Dim myAttrib As Variant
Dim i As Integer
Dim myString As String
Dim ExitFlag As Boolean

ExitFlag = False
On Error Resume Next
myString = ThisDrawing.Utility.GetString(0, "Start Number ")
i = Val(myString)
If myString = "" Then i = 1

Do
ThisDrawing.Utility.GetEntity myEntity, basePnt, "Select an object"
If Err <> 0 Then
ExitFlag = True
Else
If myEntity.EntityName = "AcDbBlockReference" Then
   myAttrib = myEntity.GetAttributes
       If UBound(myAttrib) = 0 Then
       myAttrib(0).TextString = Str$(i)
       i = i + 1
       Else
       MsgBox "Must have only 1 attribute"
       End If
   End If
End If

Loop Until ExitFlag

End Sub

 

this has just been edited to eliminate some undocumented features. :oops:

Link to comment
Share on other sites

Here is second version:

 

 (defun C:sqa (/ *error* alist atd atq  att att_ent pkx seqn)
   
 (defun *error* (msg)
 (if
   (vl-position
     msg
     '("console break"
   "Function cancelled"
   "quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (while (> (getvar "cmdactive") 0) (command))
 (setvar "cmdecho" 1)    
 (command "._undo" "_end")
 (setvar "attdia" atd)
 (setvar "attreq" atq)
 (setvar "pickbox" pkx)

 (princ)
)
 (setvar "cmdecho" 0)
 (command "._undo" "_end")
 (command "._undo" "_mark")
 (setq atd (getvar "attdia"))
 (setq atq (getvar "attreq"))
 (setq pkx (getvar "pickbox"))
 (setvar "attdia" 0)
 (setvar "attreq" 0)
 (setvar "pickbox" 6)


 (setq seqn (getint "\n\tEnter start number <1> : "))
 (if (not seqn)
   (setq seqn 1)
 )
 (while
   (setq att_ent (nentsel "\nSelect an attribute, do not miss \n"))
    (if (eq (cdr (assoc 0
            (setq alist (entget
                      (setq att (car att_ent))
                    )
            )
         )
        )
        "ATTRIB"
    )
      (progn
    (entmod (subst (cons 1 (itoa seqn)) (assoc 1 alist) alist))
    (entupd att)
    (setq seqn (1+ seqn))
      )
      (progn
    (princ "\nThere is not an attribute, you missed, buddy\n")
    (exit)
      )
    )
 )
 (command "._regen")
 (*error* nil)
 (princ)
)
(prompt "\n           | Programm loaded.\n")
(prompt "           | Type SQA to execute.")

~'J'~

Link to comment
Share on other sites

OK then, here's MY 2nd version. :D

Public Sub IncAtt()
Dim myEntity As AcadObject
Dim basePnt(0 To 2) As Double
Dim myAttrib As Variant
Dim i As Integer
Dim myString As String
Dim ExitFlag As Boolean
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant

ExitFlag = False
On Error Resume Next
myString = ThisDrawing.Utility.GetString(0, "Start Number ")
i = Val(myString)
If myString = "" Then i = 1

Do
ThisDrawing.Utility.GetSubEntity myEntity, basePnt, TransMatrix, ContextData, "Select an object"
If Err <> 0 Then
ExitFlag = True
Else
If myEntity.EntityName = "AcDbAttribute" Or myEntity.EntityName = "AcDbText" Then
   myEntity.TextString = Str$(i)
   i = i + 1
   Else
   MsgBox "You must select an Attribute or Text"
   End If

End If

Loop Until ExitFlag

End Sub

 

This time you can either select a peice of text or an attribute. It's not quite right in that the number keeps incrementing even if you select a line :? but never mind, it's a start. :lol:

Link to comment
Share on other sites

  • 4 years later...

Hello everyone!

 

My question is really stupid. Sorry... one I've installed the LISP which command should I type to launch it?

 

Thank you!

Chloé

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...