Author Topic: Issue with Numbering Reference Notes  (Read 650 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1206
Issue with Numbering Reference Notes
« on: May 16, 2018, 07:06:34 PM »
I have the LISP routine below that is setup to automatically number general notes & reference notes. Occasionally an error comes up where it will skip a line that should be numbered., this particularly happens when the line starts with a number.

I have attached a screenshot of what is happening. As I recall this started happening with AutoCAD 2017, prior to that I believe this worked correctly. Any thoughts on what is going on would be appreciated. I have also attached the required blocks, which need to be in a folder in the autocad support paths.

Code: [Select]
;*************************************************************************************************************
;    NT.lsp **
;     **
; Version 2.0 **
; Written by: Chris Wade **
;   08/02/11   **
;       **
; Completely Rewritten       **
; **
; Version 1.01 **
; Written by: Chris Wade **
;   12/13/10   **
;       **
; Bug Fixes       **
; Streamlined code       **
;       **
; Version 1.0 **
; Written by: Chris Wade **
;   12/02/10   **
;       **
; Positions and adjusts reference notes, including the following: **
; - Positions notes 0.25" from top right of title block. **
; - Positions notes 0.125" from top right of detail boxes. **
; - Positions additional notes 0.5" below notes above.  **
; - Adjusts the spacing between note titles and notes.  **
; - Adjusts width of notes to 3.5"                  **
; - Adjusts number bubbles accordingly.            **
; - Automatically adjusts layers for reference and general notes. **
;                                   **
; Instructions:                             **
; - Select notes to move.                   **
; - Select the object to align to (NOTE: Select near the upper right corner) **
;                                           **
; Notes:                                         **
; - Be sure that layers are set correctly.             **
;*************************************************************************************************************
(defun c:nt (/ *thisdrawing* SS Gap Ct Obj1 ObjType1 Txt Pt1 Pt2 MtBox1 MtBox2 Obj2 Txt2 FirstNoteDone TxtLayer)
(vl-load-com)
;Supporting Functions
(defun nt_D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
)
(defun nt_ListCheck (TstList TstString / Result Item); Code provided by AlanJT at TheSwamp.org
(vl-some '(lambda (match) (wcmatch (strcase Tststring) (strcase match))) TstList)
)
(defun nt_atn (Txt Blk Lay / Obj *ThisDrawing* *PaperSpace* PB OldPickBox NoteNum MtBox LowerLeft DistanceLeft LineNumber NilCt OldPickPt InsPt TxtHeight TxtSpacing PickPt DistanceDown InsPt2 BlkObj Attr Attlist Attr1 Rmode)
(setq RMode (getvar "RegenMode"))
(setvar "regenmode" 0)
(command "._-insert" Blk) (command)
(vl-cmdf "._zoom" "_extents")
(vl-cmdf "._zoom" ".8X")
(setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
  *PaperSpace* (vla-get-paperspace *Thisdrawing*)
  PB (fix (/ 14 (getvar "viewsize")))
  OldPickBox (getvar "pickbox")
  NoteNum 1
  DistanceLeft (/ 1 4.8)
)
(cond
((< PB 1)
(setq PB 1)
)
((> PB 50)
(setq PB 50)
)
)
(setvar "pickbox" PB)
(setq Obj (vlax-ename->vla-object Txt)
  MtBox (acet-geom-textbox (entget Txt) 0)
  LowerLeft (car MtBox)
  LineNumber 0
  NilCt 2
  InsPt (vlax-get Obj 'InsertionPoint)
  TxtHeight (vlax-get Obj 'Height)
  TxtSpacing (vlax-get Obj 'LineSpacingFactor)
  OldPickPt InsPt
)
(while (or (>= (cadr OldPickPt) (cadr LowerLeft)) (not OldPickPt))
(setq LineNumber (+ LineNumber 1)
  PickPt (cadr (nentselp "" OldPickPt))
)
(cond
((not PickPt)
(setq NilCt (+ NilCt 1))
)
(T
(cond
((> NilCt 0)
(setq NilCt 0
  DistanceDown (* TxtSpacing (* (- LineNumber 1) (/ TxtHeight 0.6)))
  InsPt2 (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ TxtHeight 2)) DistanceDown))
)
(setq BlkObj (vla-insertblock *PaperSpace* (vlax-3d-point InsPt2) Blk 1 1 1 0))
(cond
((= (vla-get-hasattributes BlkObj) :vlax-true)
(setq Attr (vla-getattributes BlkObj)
  AttList (vlax-safearray->list (variant-value Attr))
)
(mapcar 'set '(Attr1) attlist)
(vla-put-textstring Attr1 (rtos NoteNum 2 0))
)
)
(vla-put-layer BlkObj Lay)
(setq NoteNum (+ NoteNum 1))
)
)
)
)
(setq OldPickPt (polar OldPickPt (nt_D2R 270) (* TxtHeight (/ 1 0.6))))
)
(setvar "pickbox" OldPickBox)
(setvar "regenmode" RMode)
(vl-cmdf "._zoom" "_previous")
(vl-cmdf "._zoom" "_previous")
)
;End of Supporting Functions
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *thisdrawing*)
(setq TstList (List "*demo notes*" "*general notes*" "*installation notes*" "*reference notes*")); Modify this line to change the order in which notes will be placed in.
(while (not SS)
(princ "\rSelect notes: ")
(setq ss (ssget '((-4 . "<OR") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (-4 . "<OR") (2 . "*genn*") (2 . "*1M*") (-4 . "OR>") (-4 . "AND>") (-4 . "OR>"))))
)
(while (not Pt1)
(setq Pt1 (entsel "\rSelect the title block or detail box near the upper right corner: "))
)
(setq Pt2 (osnap (cadr Pt1) "_end"))
(cond
(Pt2
(setq Obj1 (vlax-ename->vla-object (car Pt1))
    Obj1Type (vla-get-objectname Obj1)
  Pt1 Pt2
)
)
(T
(setq Pt2 (car Pt1))
)
)
(cond
((= Obj1Type "AcDbBlockReference")
(cond
((wcmatch (strcase (vla-get-effectivename Obj1) T) "*bei*detail*box*")
(setq Gap 0.125)
)
(T
(setq Gap 0.25)
)
)
)
(T
(setq Gap 0.25)
)
)
(setq Ct 0)
    (while (< Ct (sslength SS))
(setq Obj1 (vlax-ename->vla-object (ssname SS Ct))
  ObjType1 (vla-get-objectname Obj1)
)
(cond
((= ObjType1 "AcDbBlockReference")
(ssdel (ssname SS Ct) ss)
(vla-delete Obj1)
(setq ct (- ct 1))
)
((= ObjType1 "AcDbMText")
(vla-put-attachmentpoint Obj1 acAttachmentPointTopLeft)
(vla-put-LineSpacingStyle Obj1 acLineSpacingStyleExactly)
)
)
(setq Ct (+ Ct 1))
)
(Foreach TstString TstList
(setq Ct 0)
(while (< Ct (sslength SS))
(setq Obj1 (vlax-ename->vla-object (ssname SS ct))
  Txt (strcase (vla-get-textstring Obj1) T)
)
(cond
((and (wcmatch txt "*\\l*") (wcmatch txt TstString) (wcmatch Txt "*hlvm1d*"))
(setq MtBox1 (acet-geom-textbox (entget (ssname ss Ct)) 0)
  Ct2 0
)
(while (< Ct2 (sslength SS))
(setq Obj2 (vlax-ename->vla-object (ssname SS Ct2))
  Txt2 (strcase (vla-get-textstring Obj2))
)
(cond
((and (not (nt_ListCheck TstList Txt2)) (not (wcmatch Txt2 "*\\l*")) (not (wcmatch Txt2 "*hlvm1d*")))
(vla-put-width Obj2 3.5)
(setq MtBox2 (acet-geom-textbox (entget (ssname ss Ct2)) 0))
(cond
((< (distance (nth 3 Mtbox1) (nth 3 MtBox2)) 0.5)
(cond
(FirstNoteDone
(vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar Pt1 (nt_d2r 270) (* Gap 2)) (nt_d2r 180) (+ 3.5 Gap))))
)
(T
(vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar Pt1 (nt_d2r 270) Gap) (nt_d2r 180) (+ 3.5 Gap))))
(setq FirstNoteDone T)
)
)
(setq MtBox1 (acet-geom-textbox (entget (ssname ss ct)) 0))
(vla-put-insertionpoint Obj2 (vlax-3d-point (polar (car MtBox1) (nt_d2r 270) 0.0625)))
(setq MTBox2 (acet-geom-textbox (entget (ssname ss ct2)) 0)
  Pt1 (list (car Pt1) (cadr (cadr MtBox2)) (caddr (cadr MtBox2)))
  TxtLayer (strcase (vla-get-layer Obj2) T)
)
(cond
((or (= TxtLayer "$gn") (wcmatch Txt "*general Notes*"))
(setq blk "genn10" ; Block for General Notes
  TxtLayer "$GN" ; Layer for General Notes
)
)
(T
(setq blk "1m10" ; Block for Reference Notes
  TxtLayer "$RN" ; Layer for Reference Notes
)
)
)
(nt_atn (ssname SS Ct2) blk Txtlayer)
)
)
)
)
(setq Ct2 (+ Ct2 1))
)
)
)
(setq Ct (+ Ct 1))
)
)
(vla-endundomark *thisdrawing*)
    (princ)
)

cmwade77

  • Swamp Rat
  • Posts: 1206
Re: Issue with Numbering Reference Notes
« Reply #1 on: May 16, 2018, 07:09:09 PM »
And just in case, here is a less automated version that runs slightly slower, but does not have the same issues, but has its own issues with lines that start with (

Code: [Select]
;*************************************************************************************************************************
;| **
ATN.LSP **
**
VERSION 1.01 **
BY: Chris Wade **
  01/11/2010 **
**
- Updated to adjust for zooming in and out. **
- Removed bug so that numbering will stop at end of text. **
- Erases existing General/Reference Note numbers (if they already exist). **
**
  VERSION 1.0 **
BY: Chris Wade **
  01/07/2010 **
**
- Loosely based on old AN.LSP file. **
- Automatically numbers reference notes or general notes based on layer. **
- Live preview of number references. **
;*************************************************************************************************************************|;
(defun C:ATN (/ Loop input OriginalText obj *error* *thisdrawing* *modelspace* *paperspace* LowLft UpRight Single OldObjName scalefactor NilCt MTLay MTName DwgName Loop OriginalText MTobj LS lS2 InsPt Theight Tspacing Oldpickpt DistanceDown NoteNum NoteNumSave blobj Attr attlist tmpss OldText OldPickBox)
(defun *error* (msg)
;(and blobj(or (and pLst (mapcar (function (lambda (x) (vlax-put blobj (car x) (cdr x)))) pLst)) (and (not (vlax-erased-p blobj)) (vla-delete blobj))))
(if (/= tmpss nil)
(vl-cmdf "._erase" tmpss "")
)
(if (/= OldPickBox nil)
(setvar "pickbox" OldPickBox)
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(vl-load-com)
(load "standards.lsp")
(cond
((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
(progn
(SETQ ScaleFactor (GETVAR "DIMSCALE"))
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(progn    
(setq ScaleFactor 1)        
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
)
  (setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
      ) ;_ end of vla-get-activedocument
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*))
(setq tmpss (ssadd))
(setq Loop T)
(setq OldPickBox (getvar "pickbox"))
(setq PB (fix (/ 14 (getvar "viewsize"))))
(if (< PB 1)
(setq PB 1)
)
(if (> PB 50)
(setq PB 50)
)
(setvar "pickbox" PB)
(princ "\nHover over text to add General/Reference Note Bubbles: (Click to accept)\nNOTE: Existing Bubbles will be erased when you hover over the text.")
(while (/= Loop nil)
(setq input (grread t 4 4))
(setq NoteNum "1")
(cond
((eq 3 (car input))
(if (/= OldPickBox nil)
(setvar "pickbox" OldPickBox)
)
(setq Loop nil)
(princ)
)
(T
(setq OriginalText (nentselp (cadr input) "._ins"))
(if (/= OriginalText nil)
(progn
(setq Mtobj (vlax-ename->vla-object (car OriginalText)))
(if (or (= Single T) (= OldObjName nil) (/= OldObjName (vla-get-ObjectID MTobj)))
(progn

(setq OldObjName (vla-get-ObjectID MTobj))
(setq MTName (vla-get-ObjectName MTobj))
(setq MTBox (acet-geom-textbox (entget (car OriginalText)) 0))
(setq LowLft (car MTBox))
(if (= MTName "AcDbMText")
(progn
(if (/= tmpss nil)
(vl-cmdf "._erase" tmpss "")
)
(setq MTLay (vla-get-layer Mtobj))
(cond
((= MTLay "$RN")
(setq DwgName "1m10")
)
((= MTLay "$GN")
(setq DwgName "genn10")
)
(T
(setq DwgName "1m10")
)
)
(if (wcmatch (strcase DwgName) "*.DWG")
(setq DwgName2 (vl-string-subst "" ".DWG" (strcase DwgName)))
(setq DwgName2 DwgName)
)
(setq ept1 (list (- (car LowLft) DistanceLeft) (cadr LowLft)))
(setq ept2 (list (+ (car ept1) (/ DistanceLeft 2)) (cadr (nth 2 MTBox))))
(setq tmp (ssget "_c" ept1 ept2 (list (cons 2 DwgName2))))

(if (/= tmp nil)
(command-s "._erase" tmp "")
)
(setq LineNumber 0)
(setq NilCt 0)
(setq OldPickPt nil)
(vla-put-attachmentpoint MTObj acAttachmentPointTopLeft)
(vla-put-LineSpacingStyle MTobj acLineSpacingStyleExactly)
(setq InsPt (vlax-get MTObj 'InsertionPoint));get mtext insertion point
(setq Theight (vlax-get MTObj 'Height));get mtext height
(setq Tspacing (vlax-get MTObj 'LineSpacingFactor));get line spacing
(while (or (>= (cadr OldPickPt) (cadr LowLft)) (= OldPickPt nil))
(setq LineNumber (+ LineNumber 1))
(if (= OldPickPt nil)
(progn
(setq OldPickPt InsPt)
(setq NilCt 2)
)
(setq OldPickPt (polar OldPickPt (* pi (/ 270 180.0)) (* Theight (/ 1 0.6))))
)
(setq PickPt (cadr (nentselp "" OldPickPt)))
(if (= PickPt nil)
(setq NilCt (+ NilCt 1))
)
(if (and (> NilCt 0) (/= PickPt nil))
(progn
(setq NilCt 0)
(setq DistanceDown (* Tspacing (* (- LineNumber 1) (/ Theight 0.6)))) ;set distance down from mtext insertion point to insert note
(setq NewInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ Theight 2)) DistanceDown))) ;combine the two into one point
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq blobj (vla-InsertBlock *modelspace* (vlax-3d-point NewInsPt) DwgName ScaleFactor ScaleFactor ScaleFactor 0))
(setq blobj (vla-InsertBlock *paperspace* (vlax-3d-point NewInsPt) DwgName ScaleFactor ScaleFactor ScaleFactor 0))
)
(if (= (vla-get-hasattributes blobj) :vlax-true)
(progn
(setq Attr (vla-GetAttributes blobj))
(setq attlist (vlax-safearray->list (variant-value Attr)))
(mapcar 'set '(theattribute1) attlist)
(vla-put-textstring theattribute1 NoteNum)
)
)
(vla-put-layer blobj MTLay)
(if (/= Single T)
(ssadd (entlast) tmpss)
)
(setq NoteNumSave (+ (atof NoteNum) 1)) ;increment counter
(setq NoteNum (rtos NoteNumSave 5 0)) ;set format of number
)
)
)
)
)
)
)
)
)
)
)
)
)
« Last Edit: May 16, 2018, 07:26:26 PM by cmwade77 »

cmwade77

  • Swamp Rat
  • Posts: 1206
Re: Issue with Numbering Reference Notes
« Reply #2 on: June 01, 2018, 05:16:17 PM »
I am in the process of fixing up both of these routines and something is currently wrong, as you can see above, the code should move the text to the correct location, but it isn't working right in my new code, I am sure the error is something like a line in the wrong place, but I can't see it at the moment. Please see the attached video, could someone please help me find the problem?

See the first post for the old code and here is the new code:

Code: [Select]
;*************************************************************************************************************
;    NT.lsp **
;     **
; Version 3.0 **
; Written by: Chris Wade **
;   06/??/18   **
;       **
; Completely Rewritten       **
;   Combines nt and atn commands into same lisp file                                                        **
;   Improves speed and reliability                                                                          **
;     **
; Version 2.0 **
; Written by: Chris Wade **
;   08/02/11   **
;       **
; Completely Rewritten       **
; **
; Version 1.01 **
; Written by: Chris Wade **
;   12/13/10   **
;       **
; Bug Fixes       **
; Streamlined code       **
;       **
; Version 1.0 **
; Written by: Chris Wade **
;   12/02/10   **
;       **
; Positions and adjusts reference notes, including the following: **
; - Positions notes 0.25" from top right of title block. **
; - Positions notes 0.125" from top right of detail boxes. **
; - Positions additional notes 0.5" below notes above.  **
; - Adjusts the spacing between note titles and notes.  **
; - Adjusts width of notes to 3.5"                  **
; - Adjusts number bubbles accordingly.            **
; - Automatically adjusts layers for reference and general notes. **
;                                   **
; Instructions:                             **
; - Select notes to move.                   **
; - Select the object to align to (NOTE: Select near the upper right corner) **
;                                           **
; Notes:                                         **
; - Be sure that layers are set correctly.             **
;*************************************************************************************************************
(vl-load-com)
(cond
((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
(progn
(SETQ ScaleFactor (GETVAR "DIMSCALE"))
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(progn    
(setq ScaleFactor 1)        
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
)

(defun nt_Numbering (Obj DistanceLeft MtBox LowerLeft DwgName MTLayer / *thisdrawing* *modelspace* *paperspace* NoteNum InsPt TextHeight TextSpacing LineNumber OldPickPt PickPt NilCt DistanceDown BlkInstPt BlkObj Attr AttList Attr1 RMode OldPickBox NewPickBox)
    (defun nt_D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
)
(vl-cmdf "._zoom" "_extents")
(vl-cmdf "._zoom" ".8x")
(setq RMode (getvar "RegenMode")
      OldPickBox (getvar "pickbox")
      NewPickBox (fix (/ 14 (getvar "viewsize")))
)
(cond
    ((< NewPickBox 1)
        (setq NewPickbox 1)
    )
    ((> NewPickBox 50)
        (setq NewPickBox 50)
    )
)
(setvar "pickbox" NewPickBox)
    (if (/= Obj nil)
        (progn
            (setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
      *PaperSpace* (vla-get-paperspace *Thisdrawing*)
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
                  NoteNum 1
                  InsPt (vlax-get Obj 'InsertionPoint)
                  TextHeight (vlax-get Obj 'Height)
                  TextSpacing (vlax-get Obj 'LineSpacingFactor)
                  LineNumber 0
                  OldPickPt InsPt
                  NilCt 2
            )
            (while (or (>= (cadr OldPickPt) (cadr LowerLeft)) (not OldPickPt))
                (setq LineNumber (1+ LineNumber)
                      PickPt (cadr (nentselp "" OldPickPt))
                )
                (if PickPt
                    (progn
                        (if (> NilCt 0)
                            (progn
                                (setq NilCt 0
                                      DistanceDown (* TextSpacing (* (- LineNumber 1) (/ TextHeight 0.6)))
                                      BlkInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ TextHeight 2)) DistanceDown))
                                      BlkObj (vla-insertblock *PaperSpace* (vlax-3d-point BlkInsPt) DwgName 1 1 1 0)
                                )
                                (if (= (vla-get-hasattributes BlkObj) :vlax-true)
                                    (progn
                                        (setq Attr (vla-getattributes BlkObj)
      AttList (vlax-safearray->list (variant-value Attr))
        )
    (mapcar 'set '(Attr1) attlist)
    (vla-put-textstring Attr1 (rtos NoteNum 2 0))
                                    )
                                )
                                (vla-put-layer BlkObj MTLayer)
        (setq NoteNum (+ NoteNum 1))
                            )
                        )
                    )
                    (setq NilCt (+ NilCt 1));Increase line count if numbering is not needed
                )
                (setq OldPickPt (polar OldPickPt (nt_D2R 270) (* TextHeight (/ 1 0.6))))
            )
        )
    )
    (setvar "pickbox" OldPickBox)
(setvar "regenmode" RMode)
(vl-cmdf "._zoom" "_previous")
(vl-cmdf "._zoom" "_previous")
)


(defun nt_EraseNumbers (Obj / tmpss ent MTName MTBox LowerLeft WindowPt1 WindowPt2 MTLayer DWGName *thisdrawing* *modelspace* *paperspace*)
    (defun *error* (msg)
(if (/= tmpss nil)
(vl-cmdf "._erase" tmpss "")
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
          ent (vlax-vla-object->ename Obj)
  MTName (vla-get-ObjectName Obj)
  MTBox (acet-geom-textbox (entget ent) 0)
  MTLayer (vla-get-layer Obj)
      LowerLeft (car MTBox)
  WindowPt1 (list (- (car LowerLeft) DistanceLeft) (cadr LowerLeft))
  WindowPt2 (list (+ (car WindowPt1) (/ DistanceLeft 2)) (cadr (nth 2 MTBox)))
    )
(if (= MTLayer "$GN")
    (setq DwgName "genn10")
    (setq DwgName "1m10")
)
(setq tmpss (ssget "_c" WindowPt1 WindowPt2 (list (cons 2 DwgName))))
(if (/= tmpss nil)
    (vl-cmdf "._erase" tmpss "")
)
(nt_Numbering Obj DistanceLeft MtBox LowerLeft DwgName MTLayer)
)

(defun nt_SelectText (mode / ss Total ct NoteTypes UpperRight TbPt TitleBlock Gap NoteType ent TestObj Text Box1 Box2 Obj1 ObjType1 Ct2 Obj2 ObjType2 Text2 FirstNoteDone TextLayer);Mode 0 = Select Text / Mode 1 = Hover over Text
    (defun nt_ListCheck (TstList TstString / Result Item); Code provided by AlanJT at TheSwamp.org
(vl-some '(lambda (match) (wcmatch (strcase Tststring) (strcase match))) TstList)
)

    (cond
        ((= mode 0); Select Text
            (princ "\nPlease select text to number:")
            (setq ss (ssget '((0 . "MTEXT")))
                  NoteTypes (list "*demo notes*" "*general notes*" "*installation notes*" "*reference notes*" "* notes")
            )
            (while (not TbPt)
                (setq TbPt (entsel "\rSelect the upper right corner of the title block or detail box:"))
            )
            (setq UpperRight (osnap (cadr TbPt) "_end"))
            (if UpperRight
                (progn
                    (setq TitleBlock (vlax-ename->vla-object (car TbPt))
                          TitleBlockType (vla-get-objectname TitleBlock)
                    )
                   
                    (if (= TitleBlockType "AcDbBlockReference")
                        (progn
                            (if (wcmatch (strcase (vla-get-effectivename TitleBlock) T) "*bei*detail*box*")
                                (setq Gap (* 0.125 ScaleFactor))
                                (setq Gap (* 0.25 ScaleFactor))
                            )
                        )
                        (setq Gap (* 0.25 ScaleFactor))
                    )
                )
                (setq UpperRight (car TbPt))
            )
           
            (setq ct 0)
            (while (< Ct (sslength SS))
                (setq Obj1 (vlax-ename->vla-object (ssname SS Ct))
          ObjType1 (vla-get-objectname Obj1)
        )
        (cond
            ((= ObjType1 "AcDbMText")
                (vla-put-attachmentpoint Obj1 acAttachmentPointTopLeft)
        (vla-put-LineSpacingStyle Obj1 acLineSpacingStyleExactly)
        (setq Text (strcase (vla-get-textstring Obj1) T))
        (if (and (not (wcmatch Text "*\\l*")) (not (wcmatch Text "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text)))
            (progn
                (vla-put-width Obj1 (* 3.5 ScaleFactor))
            )
        )
            )
        )
        (setq ct (+ ct 1))
            )
            (setq ct 0)
            (while (< Ct (sslength SS))
                (setq Ent (ssname SS ct)
                      TestObj (vlax-ename->vla-object ent)
                      Text (strcase (vla-get-textstring TestObj) T)
                )
                (if (or (wcmatch Text "*\\l*") (wcmatch Text "*hlvm1d*") (nt_ListCheck NoteTypes Text))
                    (progn
                        (setq Box1 (acet-geom-textbox (entget Ent) 0)
                              Ct2 0
                        )
                        (ssdel (ssname SS ct) SS)
                        (while (< Ct2 (sslength SS))
                                (progn
                                    (setq Obj2 (vlax-ename->vla-object (ssname SS Ct2))
              Text2 (strcase (vla-get-textstring Obj2))
                                          Box2 (acet-geom-textbox (entget (ssname ss Ct2)) 0)
                                    )
                                    (if (and (not (wcmatch Text2 "*\\l*")) (not (wcmatch Text2 "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text2)))
                                        (progn
                                            (if (< (distance (nth 3 Box1) (nth 3 Box2)) (* 0.5 ScaleFactor))
                                                (progn
                                                    (cond
                                                        (FirstNoteDone
                                                            (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) (* Gap 2)) (nt_d2r 180) (+ 3.5 Gap))))
                                                        )
                                                        (T
                                                            (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) Gap) (nt_d2r 180) (+ 3.5 Gap))))
                                                            (setq FirstNoteDone T)
                                                        )
                                                    )
                                                    (setq Box1 (acet-geom-textbox (entget Ent) 0))
                                                    (vla-put-insertionpoint Obj2 (vlax-3d-point (polar (car Box1) (nt_d2r 270) (* 0.0625 ScaleFactor))))
                                                    (setq Box2 (acet-geom-textbox (entget (ssname ss ct2)) 0)
                                                          UpperRight (list (car UpperRight) (cadr (cadr Box2)) (caddr (cadr Box2)))
                                                          TextLayer (strcase (vla-get-layer Obj2) T)
                                                    )
                                                    (cond
                                                        ((or (= TxtLayer "$gn") (wcmatch Text "*general notes*"))
                                                            (setq blk "genn10" ; Block for General Notes
                  TxtLayer "$GN" ; Layer for General Notes
                )
                                                        )
                                                        (T
                                                            (setq blk "1m10" ; Block for General Notes
                  TxtLayer "$RN" ; Layer for General Notes
                )
                                                        )
                                                    )
                                                    (vla-put-layer Obj1 TxtLayer)
                                                    (vla-put-layer Obj2 TxtLayer)
                                                )
                                            )
                                        )
                                    )
                                )
                            (setq ct2 (+ ct2 1))
                       )
                    )
                )
                (setq ct (+ ct 1))
            )
           
        )
        ((= mode 1)
            (setq ss nil
                  ss (ssadd)
            )
        )
    )
    (if (/= ss nil)
        (progn
            (setq Total (sslength ss)
                  ct 0
            )
            (while (< ct Total)
                (setq ent (ssname SS ct)
                      ct (+ ct 1)
                      Obj (vlax-ename->vla-object ent)
                )
                (nt_EraseNumbers Obj)
               
            )
        )
    )
)
(defun c:nt (/)
    (nt_SelectText 0)
)
(defun c:atn (/)
    (nt_SelectText 1)
)

« Last Edit: June 01, 2018, 05:20:42 PM by cmwade77 »

cmwade77

  • Swamp Rat
  • Posts: 1206
Re: Issue with Numbering Reference Notes
« Reply #3 on: June 01, 2018, 06:38:14 PM »
I actually figured that part of it out and fixed an error when lines started with -

Now to add my second mode in, then I think this may be good.


Code: [Select]
;*************************************************************************************************************
;    NT.lsp **
;     **
; Version 3.0 **
; Written by: Chris Wade **
;   06/??/18   **
;       **
; Completely Rewritten       **
;   Combines nt and atn commands into same lisp file                                                        **
;   Improves speed and reliability                                                                          **
;     **
; Version 2.0 **
; Written by: Chris Wade **
;   08/02/11   **
;       **
; Completely Rewritten       **
; **
; Version 1.01 **
; Written by: Chris Wade **
;   12/13/10   **
;       **
; Bug Fixes       **
; Streamlined code       **
;       **
; Version 1.0 **
; Written by: Chris Wade **
;   12/02/10   **
;       **
; Positions and adjusts reference notes, including the following: **
; - Positions notes 0.25" from top right of title block. **
; - Positions notes 0.125" from top right of detail boxes. **
; - Positions additional notes 0.5" below notes above.  **
; - Adjusts the spacing between note titles and notes.  **
; - Adjusts width of notes to 3.5"                  **
; - Adjusts number bubbles accordingly.            **
; - Automatically adjusts layers for reference and general notes. **
;                                   **
; Instructions:                             **
; - Select notes to move.                   **
; - Select the object to align to (NOTE: Select near the upper right corner) **
;                                           **
; Notes:                                         **
; - Be sure that layers are set correctly.             **
;*************************************************************************************************************
(vl-load-com)
(cond
((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
(progn
(SETQ ScaleFactor (GETVAR "DIMSCALE"))
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(progn    
(setq ScaleFactor 1)        
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
)
(defun nt_D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
)

(defun nt_ReplaceAll (Text OldChar NewChar / )
    (while (/= (vl-string-search OldChar Text) nil)
        (setq Text (vl-string-subst NewChar OldChar Text))
    )
    Text
)
(defun nt_Numbering (Obj DistanceLeft MtBox LowerLeft DwgName MTLayer / TmpPt Text *thisdrawing* *modelspace* *paperspace* NoteNum InsPt TextHeight TextSpacing LineNumber OldPickPt PickPt NilCt DistanceDown BlkInstPt BlkObj Attr AttList Attr1 RMode OldPickBox NewPickBox)
    (defun *error* (msg)
(if (/= *ThisDrawing* nil)
    (vla-endundomark *thisdrawing*)
)
(if (/= OldPickBox nil)
(setvar "pickbox" OldPickBox)
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(vl-cmdf "._zoom" "_extents")
(vl-cmdf "._zoom" ".8x")
(setq RMode (getvar "RegenMode")
      OldPickBox (getvar "pickbox")
      NewPickBox (fix (/ 14 (getvar "viewsize")))
)
(cond
    ((< NewPickBox 1)
        (setq NewPickbox 1)
    )
    ((> NewPickBox 50)
        (setq NewPickBox 50)
    )
)
(setvar "pickbox" NewPickBox)
    (if (/= Obj nil)
        (progn
            (setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
      *PaperSpace* (vla-get-paperspace *Thisdrawing*)
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
                  NoteNum 1
                  InsPt (vlax-get Obj 'InsertionPoint)
                  TextHeight (vlax-get Obj 'Height)
                  TextSpacing (vlax-get Obj 'LineSpacingFactor)
                  LineNumber 0
                  OldPickPt InsPt
                  NilCt 2
            )
                        (while (or (>= (cadr OldPickPt) (cadr LowerLeft)) (not OldPickPt))
                (setq LineNumber (1+ LineNumber)
                      PickPt (cadr (nentselp "" OldPickPt))
                )
                (if (not PickPt)
                    (progn
                        (setq TmpPt (polar OldPickPt (nt_D2R 270) (/ TextHeight 2))
                              PickPt (cadr (nentselp "" TmpPt))
                        )
                        (if (not PickPt)
                            (progn
                                (setq TmpPt (polar TmpPt (nt_D2R 270) (/ TextHeight 2))
                                      PickPt (cadr (nentselp "" TmpPt))
                                )
                            )
                        )
                    )
                )
               
                (if PickPt
                    (progn
                        (if (> NilCt 0)
                            (progn
                                (setq NilCt 0
                                      DistanceDown (* TextSpacing (* (- LineNumber 1) (/ TextHeight 0.6)))
                                      BlkInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ TextHeight 2)) DistanceDown))
                                      BlkObj (vla-insertblock *PaperSpace* (vlax-3d-point BlkInsPt) DwgName 1 1 1 0)
                                )
                                (if (= (vla-get-hasattributes BlkObj) :vlax-true)
                                    (progn
                                        (setq Attr (vla-getattributes BlkObj)
      AttList (vlax-safearray->list (variant-value Attr))
        )
    (mapcar 'set '(Attr1) attlist)
    (vla-put-textstring Attr1 (rtos NoteNum 2 0))
                                    )
                                )
                                (vla-put-layer BlkObj MTLayer)
        (setq NoteNum (+ NoteNum 1))
                            )
                        )
                       
                    )
                    (setq NilCt (+ NilCt 1));Increase line count if numbering is not needed
                )
                (setq OldPickPt (polar OldPickPt (nt_D2R 270) (* TextHeight (/ 1 0.6))))
            )
        )
    )
    (setvar "pickbox" OldPickBox)
(setvar "regenmode" RMode)
(vl-cmdf "._zoom" "_previous")
(vl-cmdf "._zoom" "_previous")
)


(defun nt_EraseNumbers (Obj EraseOnly / tmpss ent MTName MTBox LowerLeft WindowPt1 WindowPt2 MTLayer DWGName *thisdrawing* *modelspace* *paperspace*)
    (defun *error* (msg)
(if (/= tmpss nil)
(vl-cmdf "._erase" tmpss "")
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
          ent (vlax-vla-object->ename Obj)
  MTName (vla-get-ObjectName Obj)
  MTBox (acet-geom-textbox (entget ent) 0)
  MTLayer (vla-get-layer Obj)
      LowerLeft (car MTBox)
  WindowPt1 (list (- (car LowerLeft) DistanceLeft) (cadr LowerLeft))
  WindowPt2 (list (+ (car WindowPt1) (/ DistanceLeft 2)) (cadr (nth 2 MTBox)))
    )
(if (= MTLayer "$GN")
    (setq DwgName "genn10")
    (setq DwgName "1m10")
)
(setq tmpss (ssget "_c" WindowPt1 WindowPt2 (list (cons 2 DwgName))))
(if (/= tmpss nil)
    (vl-cmdf "._erase" tmpss "")
)
(if (= EraseOnly 0)
    (nt_Numbering Obj DistanceLeft MtBox LowerLeft DwgName MTLayer)
)
)

(defun nt_SelectText (mode / ss Total ct NoteTypes UpperRight TbPt TitleBlock Gap NoteType ent TestObj Text Box1 Box2 Obj1 ObjType1 Ct2 Obj2 ObjType2 Text2 FirstNoteDone TextLayer TestString);Mode 0 = Select Text / Mode 1 = Hover over Text
    (defun nt_ListCheck (TstList TstString / Result Item); Code provided by AlanJT at TheSwamp.org
(vl-some '(lambda (match) (wcmatch (strcase Tststring) (strcase match))) TstList)
)

    (cond
        ((= mode 0); Select Text
            (princ "\nPlease select text to number:")
            (setq ss (ssget '((0 . "MTEXT")))
                  NoteTypes (list "*demo notes*" "*general notes*" "*installation notes*" "*reference notes*" "* notes")
            )
            (while (not TbPt)
                (setq TbPt (entsel "\rSelect the upper right corner of the title block or detail box:"))
            )
            (setq UpperRight (osnap (cadr TbPt) "_end"))
            (if UpperRight
                (progn
                    (setq TitleBlock (vlax-ename->vla-object (car TbPt))
                          TitleBlockType (vla-get-objectname TitleBlock)
                    )
                   
                    (if (= TitleBlockType "AcDbBlockReference")
                        (progn
                            (if (wcmatch (strcase (vla-get-effectivename TitleBlock) T) "*bei*detail*box*")
                                (setq Gap (* 0.125 ScaleFactor))
                                (setq Gap (* 0.25 ScaleFactor))
                            )
                        )
                        (setq Gap (* 0.25 ScaleFactor))
                    )
                )
                (setq UpperRight (car TbPt))
            )
           
            (setq ct 0)
            (while (< Ct (sslength SS))
                (setq Obj1 (vlax-ename->vla-object (ssname SS Ct))
          ObjType1 (vla-get-objectname Obj1)
        )
        (cond
            ((= ObjType1 "AcDbMText")
                (vla-put-attachmentpoint Obj1 acAttachmentPointTopLeft)
        (vla-put-LineSpacingStyle Obj1 acLineSpacingStyleExactly)
        (setq Text (strcase (vla-get-textstring Obj1) T))
        (if (and (not (wcmatch Text "*\\l*")) (not (wcmatch Text "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text)))
            (progn
                (vla-put-width Obj1 (* 3.5 ScaleFactor))
            )
        )
            )
        )
        (setq ct (+ ct 1))
            )
                (setq ct 0)
                (while (< Ct (sslength SS))
                    (setq Ent (ssname SS ct)
                          Obj1 (vlax-ename->vla-object ent)
                          Text (strcase (vla-get-textstring Obj1) T)
                    )
                    (if (or (wcmatch Text "*\\l*") (wcmatch Text "*hlvm1d*") (nt_ListCheck NoteTypes Text))
                        (progn
                            (setq Box1 (acet-geom-textbox (entget Ent) 0)
                                  Ct2 0
                            )
                            (ssdel (ssname SS ct) SS)
                            (while (< Ct2 (sslength SS))
                                    (progn
                                        (setq Obj2 (vlax-ename->vla-object (ssname SS Ct2))
                  Text2 (strcase (vla-get-textstring Obj2))
                                              Box2 (acet-geom-textbox (entget (ssname ss Ct2)) 0)
                                        )
                                        (if (and (not (wcmatch Text2 "*\\l*")) (not (wcmatch Text2 "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text2)))
                                            (progn
                                                (nt_EraseNumbers Obj2 1)
                                                (if (< (distance (nth 3 Box1) (nth 3 Box2)) (* 0.5 ScaleFactor))
                                                    (progn
                                                        (cond
                                                            (FirstNoteDone
                                                                (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) (* Gap 2)) (nt_d2r 180) (+ 3.5 Gap))))
                                                            )
                                                            (T
                                                                (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) Gap) (nt_d2r 180) (+ 3.5 Gap))))
                                                                (setq FirstNoteDone T)
                                                            )
                                                        )
                                                        (setq Box1 (acet-geom-textbox (entget Ent) 0))
                                                        (vla-put-insertionpoint Obj2 (vlax-3d-point (polar (car Box1) (nt_d2r 270) (* 0.0625 ScaleFactor))))
                                                        (setq Box2 (acet-geom-textbox (entget (ssname ss ct2)) 0)
                                                              UpperRight (list (car UpperRight) (cadr (cadr Box2)) (caddr (cadr Box2)))
                                                              TextLayer (strcase (vla-get-layer Obj2) T)
                                                        )
                                                        (cond
                                                            ((or (= TxtLayer "$gn") (wcmatch Text "*general notes*"))
                                                                (setq blk "genn10" ; Block for General Notes
                      TxtLayer "$GN" ; Layer for General Notes
                    )
                                                            )
                                                            (T
                                                                (setq blk "1m10" ; Block for General Notes
                      TxtLayer "$RN" ; Layer for General Notes
                    )
                                                            )
                                                        )
                                                        (vla-put-layer Obj1 TxtLayer)
                                                        (vla-put-layer Obj2 TxtLayer)
                                                    )
                                                )
                                            )
                                        )
                                    )
                                (setq ct2 (+ ct2 1))
                           )
                        )
                    )
                    (setq ct (+ ct 1))
                );End While
        )
        ((= mode 1)
            (setq ss nil
                  ss (ssadd)
            )
        )
    )
    (if (/= ss nil)
        (progn
            (setq Total (sslength ss)
                  ct 0
            )
            (while (< ct Total)
                (setq ent (ssname SS ct)
                      ct (+ ct 1)
                      Obj (vlax-ename->vla-object ent)
                )
                (nt_EraseNumbers Obj 0)
               
            )
        )
    )
)
(defun c:nt (/ *thisdrawing*)
    (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *thisdrawing*)
    (nt_SelectText 0)
    (vla-endundomark *thisdrawing*)
)
(defun c:atn (/)
    (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *thisdrawing*)
    (nt_SelectText 1)
    (vla-endundomark *thisdrawing*)
)

cmwade77

  • Swamp Rat
  • Posts: 1206
Re: Issue with Numbering Reference Notes
« Reply #4 on: June 01, 2018, 07:27:13 PM »
Adding the second mode was a lot easier, here is my current code, I would like any and all comments:

Code: [Select]
;*************************************************************************************************************
;    NT.lsp **
;     **
; Version 3.0 **
; Written by: Chris Wade **
;   06/??/18   **
;       **
; Completely Rewritten       **
;   Combines nt and atn commands into same lisp file                                                        **
;   Improves speed and reliability                                                                          **
;     **
; Version 2.0 **
; Written by: Chris Wade **
;   08/02/11   **
;       **
; Completely Rewritten       **
; **
; Version 1.01 **
; Written by: Chris Wade **
;   12/13/10   **
;       **
; Bug Fixes       **
; Streamlined code       **
;       **
; Version 1.0 **
; Written by: Chris Wade **
;   12/02/10   **
;       **
; Positions and adjusts reference notes, including the following: **
; - Positions notes 0.25" from top right of title block. **
; - Positions notes 0.125" from top right of detail boxes. **
; - Positions additional notes 0.5" below notes above.  **
; - Adjusts the spacing between note titles and notes.  **
; - Adjusts width of notes to 3.5"                  **
; - Adjusts number bubbles accordingly.            **
; - Automatically adjusts layers for reference and general notes. **
;                                   **
; Instructions:                             **
; - Select notes to move.                   **
; - Select the object to align to (NOTE: Select near the upper right corner) **
;                                           **
; Notes:                                         **
; - Be sure that layers are set correctly.             **
;*************************************************************************************************************
(vl-load-com)
(cond
((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
(progn
(SETQ ScaleFactor (GETVAR "DIMSCALE"))
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(progn    
(setq ScaleFactor 1)        
(SETQ DistanceLeft (/ ScaleFactor 4.8))    
)
)
)
(defun nt_D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
)

(defun nt_ReplaceAll (Text OldChar NewChar / )
    (while (/= (vl-string-search OldChar Text) nil)
        (setq Text (vl-string-subst NewChar OldChar Text))
    )
    Text
)
(defun nt_Numbering (Obj DistanceLeft MtBox LowerLeft DwgName MTLayer / TmpPt Text *thisdrawing* *modelspace* *paperspace* NoteNum InsPt TextHeight TextSpacing LineNumber OldPickPt PickPt NilCt DistanceDown BlkInstPt BlkObj Attr AttList Attr1 RMode OldPickBox NewPickBox)
    (defun *error* (msg)
(if (/= *ThisDrawing* nil)
    (vla-endundomark *thisdrawing*)
)
(if (/= OldPickBox nil)
(setvar "pickbox" OldPickBox)
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(vl-cmdf "._zoom" "_extents")
(vl-cmdf "._zoom" ".8x")
(setq RMode (getvar "RegenMode")
      OldPickBox (getvar "pickbox")
      NewPickBox (fix (/ 14 (getvar "viewsize")))
)
(cond
    ((< NewPickBox 1)
        (setq NewPickbox 1)
    )
    ((> NewPickBox 50)
        (setq NewPickBox 50)
    )
)
(setvar "pickbox" NewPickBox)
    (if (/= Obj nil)
        (progn
            (setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
      *PaperSpace* (vla-get-paperspace *Thisdrawing*)
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
                  NoteNum 1
                  InsPt (vlax-get Obj 'InsertionPoint)
                  TextHeight (vlax-get Obj 'Height)
                  TextSpacing (vlax-get Obj 'LineSpacingFactor)
                  LineNumber 0
                  OldPickPt InsPt
                  NilCt 2
            )
                        (while (or (>= (cadr OldPickPt) (cadr LowerLeft)) (not OldPickPt))
                (setq LineNumber (1+ LineNumber)
                      PickPt (cadr (nentselp "" OldPickPt))
                )
                (if (not PickPt)
                    (progn
                        (setq TmpPt (polar OldPickPt (nt_D2R 270) (/ TextHeight 2))
                              PickPt (cadr (nentselp "" TmpPt))
                        )
                        (if (not PickPt)
                            (progn
                                (setq TmpPt (polar TmpPt (nt_D2R 270) (/ TextHeight 2))
                                      PickPt (cadr (nentselp "" TmpPt))
                                )
                            )
                        )
                    )
                )
               
                (if PickPt
                    (progn
                        (if (> NilCt 0)
                            (progn
                                (setq NilCt 0
                                      DistanceDown (* TextSpacing (* (- LineNumber 1) (/ TextHeight 0.6)))
                                      BlkInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ TextHeight 2)) DistanceDown))
                                      BlkObj (vla-insertblock *PaperSpace* (vlax-3d-point BlkInsPt) DwgName 1 1 1 0)
                                )
                                (if (= (vla-get-hasattributes BlkObj) :vlax-true)
                                    (progn
                                        (setq Attr (vla-getattributes BlkObj)
      AttList (vlax-safearray->list (variant-value Attr))
        )
    (mapcar 'set '(Attr1) attlist)
    (vla-put-textstring Attr1 (rtos NoteNum 2 0))
                                    )
                                )
                                (vla-put-layer BlkObj MTLayer)
        (setq NoteNum (+ NoteNum 1))
                            )
                        )
                       
                    )
                    (setq NilCt (+ NilCt 1));Increase line count if numbering is not needed
                )
                (setq OldPickPt (polar OldPickPt (nt_D2R 270) (* TextHeight (/ 1 0.6))))
            )
        )
    )
    (setvar "pickbox" OldPickBox)
(setvar "regenmode" RMode)
(vl-cmdf "._zoom" "_previous")
(vl-cmdf "._zoom" "_previous")
)


(defun nt_EraseNumbers (Obj EraseOnly / tmpss ent MTName MTBox LowerLeft WindowPt1 WindowPt2 MTLayer DWGName *thisdrawing* *modelspace* *paperspace*)
    (defun *error* (msg)
(if (/= tmpss nil)
(vl-cmdf "._erase" tmpss "")
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
          ent (vlax-vla-object->ename Obj)
  MTName (vla-get-ObjectName Obj)
  MTBox (acet-geom-textbox (entget ent) 0)
  MTLayer (vla-get-layer Obj)
      LowerLeft (car MTBox)
  WindowPt1 (list (- (car LowerLeft) DistanceLeft) (cadr LowerLeft))
  WindowPt2 (list (+ (car WindowPt1) (/ DistanceLeft 2)) (cadr (nth 2 MTBox)))
    )
(if (= MTLayer "$GN")
    (setq DwgName "genn10")
    (setq DwgName "1m10")
)
(setq tmpss (ssget "_c" WindowPt1 WindowPt2 (list (cons 2 DwgName))))
(if (/= tmpss nil)
    (vl-cmdf "._erase" tmpss "")
)
(if (= EraseOnly 0)
    (nt_Numbering Obj DistanceLeft MtBox LowerLeft DwgName MTLayer)
)
)

(defun nt_SelectText (mode / *thisdrawing* data input ObjID OldObjID Obj ObjType StopLoop ss Total ct NoteTypes UpperRight TbPt TitleBlock Gap NoteType ent TestObj Text Box1 Box2 Obj1 ObjType1 Ct2 Obj2 ObjType2 Text2 FirstNoteDone TextLayer TestString);Mode 0 = Select Text / Mode 1 = Hover over Text
    (defun nt_ListCheck (TstList TstString / Result Item); Code provided by AlanJT at TheSwamp.org
(vl-some '(lambda (match) (wcmatch (strcase Tststring) (strcase match))) TstList)
)

    (cond
        ((= mode 0); Select Text
            (princ "\nPlease select text to number:")
            (setq ss (ssget '((0 . "MTEXT")))
                  NoteTypes (list "*demo notes*" "*general notes*" "*installation notes*" "*reference notes*" "* notes")
            )
            (while (not TbPt)
                (setq TbPt (entsel "\rSelect the upper right corner of the title block or detail box:"))
            )
            (setq UpperRight (osnap (cadr TbPt) "_end"))
            (if UpperRight
                (progn
                    (setq TitleBlock (vlax-ename->vla-object (car TbPt))
                          TitleBlockType (vla-get-objectname TitleBlock)
                    )
                   
                    (if (= TitleBlockType "AcDbBlockReference")
                        (progn
                            (if (wcmatch (strcase (vla-get-effectivename TitleBlock) T) "*bei*detail*box*")
                                (setq Gap (* 0.125 ScaleFactor))
                                (setq Gap (* 0.25 ScaleFactor))
                            )
                        )
                        (setq Gap (* 0.25 ScaleFactor))
                    )
                )
                (setq UpperRight (car TbPt))
            )
           
            (setq ct 0)
            (while (< Ct (sslength SS))
                (setq Obj1 (vlax-ename->vla-object (ssname SS Ct))
          ObjType1 (vla-get-objectname Obj1)
        )
        (cond
            ((= ObjType1 "AcDbMText")
                (vla-put-attachmentpoint Obj1 acAttachmentPointTopLeft)
        (vla-put-LineSpacingStyle Obj1 acLineSpacingStyleExactly)
        (setq Text (strcase (vla-get-textstring Obj1) T))
        (if (and (not (wcmatch Text "*\\l*")) (not (wcmatch Text "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text)))
            (progn
                (vla-put-width Obj1 (* 3.5 ScaleFactor))
            )
        )
            )
        )
        (setq ct (+ ct 1))
            )
                (setq ct 0)
                (while (< Ct (sslength SS))
                    (setq Ent (ssname SS ct)
                          Obj1 (vlax-ename->vla-object ent)
                          Text (strcase (vla-get-textstring Obj1) T)
                    )
                    (if (or (wcmatch Text "*\\l*") (wcmatch Text "*hlvm1d*") (nt_ListCheck NoteTypes Text))
                        (progn
                            (setq Box1 (acet-geom-textbox (entget Ent) 0)
                                  Ct2 0
                            )
                            (ssdel (ssname SS ct) SS)
                            (while (< Ct2 (sslength SS))
                                    (progn
                                        (setq Obj2 (vlax-ename->vla-object (ssname SS Ct2))
                  Text2 (strcase (vla-get-textstring Obj2))
                                              Box2 (acet-geom-textbox (entget (ssname ss Ct2)) 0)
                                        )
                                        (if (and (not (wcmatch Text2 "*\\l*")) (not (wcmatch Text2 "*hlvm1d*")) (not (nt_ListCheck NoteTypes Text2)))
                                            (progn
                                                (nt_EraseNumbers Obj2 1)
                                                (if (< (distance (nth 3 Box1) (nth 3 Box2)) (* 0.5 ScaleFactor))
                                                    (progn
                                                        (cond
                                                            (FirstNoteDone
                                                                (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) (* Gap 2)) (nt_d2r 180) (+ 3.5 Gap))))
                                                            )
                                                            (T
                                                                (vla-put-insertionpoint Obj1 (vlax-3d-point (polar (polar UpperRight (nt_d2r 270) Gap) (nt_d2r 180) (+ 3.5 Gap))))
                                                                (setq FirstNoteDone T)
                                                            )
                                                        )
                                                        (setq Box1 (acet-geom-textbox (entget Ent) 0))
                                                        (vla-put-insertionpoint Obj2 (vlax-3d-point (polar (car Box1) (nt_d2r 270) (* 0.0625 ScaleFactor))))
                                                        (setq Box2 (acet-geom-textbox (entget (ssname ss ct2)) 0)
                                                              UpperRight (list (car UpperRight) (cadr (cadr Box2)) (caddr (cadr Box2)))
                                                              TextLayer (strcase (vla-get-layer Obj2) T)
                                                        )
                                                        (cond
                                                            ((or (= TxtLayer "$gn") (wcmatch Text "*general notes*"))
                                                                (setq blk "genn10" ; Block for General Notes
                      TxtLayer "$GN" ; Layer for General Notes
                    )
                                                            )
                                                            (T
                                                                (setq blk "1m10" ; Block for General Notes
                      TxtLayer "$RN" ; Layer for General Notes
                    )
                                                            )
                                                        )
                                                        (vla-put-layer Obj1 TxtLayer)
                                                        (vla-put-layer Obj2 TxtLayer)
                                                    )
                                                )
                                            )
                                        )
                                    )
                                (setq ct2 (+ ct2 1))
                           )
                        )
                    )
                    (setq ct (+ ct 1))
                );End While
                    (if (/= ss nil)
                        (progn
                            (setq Total (sslength ss)
                                  ct 0
                            )
                            (while (< ct Total)
                                (setq ent (ssname SS ct)
                                      ct (+ ct 1)
                                      Obj (vlax-ename->vla-object ent)
                                )
                                (nt_EraseNumbers Obj 0)
                               
                            )
                        )
                    )
        )
        ((= mode 1)
            (while (= StopLoop nil)
                (princ "\rHover over the text you want to number [Cancel/Click to Accept]:")
                (setq input (grread t 4 2)
                      data (cadr input)
                )
                (cond
                    ((and (eq 2 (car input)) (or (= data 99) (= data 67)))
                        (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
                        (vla-endundomark *thisdrawing*)
                        (command "._undo" "1")
                        (setq StopLoop T)
                    )
                    ((eq 3 (car input))
                        (setq StopLoop T)
                    )
                    (T
                        (setq OriginalText (nentselp (cadr input) "._ins"))
                        (if (/= OriginalText nil)
                            (progn
                                (setq Obj (vlax-ename->vla-object (car OriginalText)))
                                (if (/= Obj nil)
                                    (progn
                                        (setq ObjType (vla-get-ObjectName Obj)
                                              ObjID (vla-get-ObjectID Obj)
                                        )
                                        (if (and (= ObjType "AcDbMText") (/= ObjID OldObjID))
                                            (progn
                                                (setq OldObjID ObjID)
                                                (nt_EraseNumbers Obj 0)
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
        )
    )
)
(defun c:nt (/ *thisdrawing*)
    (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *thisdrawing*)
    (nt_SelectText 0)
    (vla-endundomark *thisdrawing*)
)
(defun c:atn (/ *thisdrawing*)
    (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *thisdrawing*)
    (nt_SelectText 1)
    (vla-endundomark *thisdrawing*)
)