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:
;*************************************************************************************************************
; 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)
)
