Jump to content

Help with lisp editing to define layers?


Torro

Recommended Posts

Hi All I have tried to figure this out but, well, I'm just not very good at lisp editing...

 

I've been using Lee Mac's incredibly useful "Label" lisp but what I want to do ideally is alter the code so that my labels are written automatically to a specific layer (for example "MISC_TEXT") rather than to the current layer.

 

(defun c:label
    
   (
       /
       *error*
       _StartUndo
       _EndUndo
       _CurveObject-p
       _FixDXFData
       _CopyNested
       _SelectIf
       _MakeReadable

       acdoc acspc d di ent factor g1 g2 g3 gr mat msg obj p1 p2 sel str ucsnm ucsxa
   )

   (setq factor (/ (getvar 'textsize) (cond ((getvar 'cannoscalevalue)) (1.0)))
         *off*  (cond (*off*) (1.0))
         *per*  (cond (*per*) ((/ pi 2.0)))
         *bak*  (cond (*bak*) (:vlax-false))
   )

   (defun *error* ( msg )
       (if (and mat ent) (entdel ent))
       (if (and obj (not (vlax-erased-p obj))) (vla-delete obj))
       (if acdoc (_EndUndo acdoc))
       (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (defun _StartUndo ( doc )
       (_EndUndo doc)
       (vla-StartUndoMark doc)
   )

   (defun _EndUndo ( doc )
       (while (= 8 (logand 8 (getvar 'UNDOCTL)))
           (vla-EndUndoMark doc)
       )
   )

   (defun _CurveObject-p ( ent )
       (null
           (vl-catch-all-error-p
               (vl-catch-all-apply 'vlax-curve-getendparam (list ent))
           )
       )
   )

   (defun _FixDXFData ( elst )
       (vl-remove-if '(lambda ( pair ) (member (car pair) '(5 6 8 102 330))) elst)
   )

   (defun _CopyNested ( ent mat / elst )
       (setq elst (entget ent))
       (cond
           (   (setq ent
                   (cond
                       (   (eq "VERTEX" (cdr (assoc 0 elst)))
                           (entmakex (_FixDXFData (entget (setq ent (cdr (assoc 330 elst))))))
                           (while (not (eq "SEQEND" (cdr (assoc 0 (setq elst (entget (setq ent (entnext ent))))))))
                               (entmakex (_FixDXFData elst))
                           )
                           (cdr (assoc 330 (entget (entmakex (_FixDXFData elst)))))
                       )
                       (   (entmakex (_FixDXFData elst))   )
                   )
               )
               (if mat (vla-transformby (vlax-ename->vla-object ent) (vlax-tmatrix mat)))
               ent
           )
       )
   )
   
   (defun _SelectIf ( msg pred )
       (
           (lambda ( f / sel )
               (while
                   (progn (setvar 'ERRNO 0) (setq sel (nentselp msg))
                       (cond
                           (   (= 7 (getvar 'ERRNO))
                               (princ "\nMissed, try again.")
                           )
                           (   (eq 'ENAME (type (car sel)))
                               (if (and f (null (f (car sel))))
                                   (princ "\nInvalid Object.")
                               )
                           )
                       )
                   )
               )
               sel
           )
           (eval pred)
       )
   )

   (defun _MakeReadable ( a )
       (
           (lambda ( a )
               (if (and (< (/ pi 2.0) a) (<= a (/ (* 3.0 pi) 2.0)))
                   (+ a pi)
                   a
               )
           )
           (rem (+ a pi pi) (+ pi pi))
       )
   )

   (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
         acspc (vlax-get-property acdoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
         ucsnm (trans '(0. 0. 1.) 1 0 t)
         ucsxa (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 ucsnm))
   )
   (_StartUndo acdoc)
   (cond
       (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'clayer))))))
           (princ "\nCurrent Layer Locked.")
       )
       (   (null
               (and
                   (setq *str*
                       (cond
                           (   (eq ""
                                   (setq str
                                       (getstring t
                                           (strcat "\nSpecify Label"
                                               (if *str* (strcat " <" *str* ">: ") ": ")
                                           )
                                       )
                                   )
                               )
                               *str*
                           )
                           (   str   )
                       )
                   )
                   (setq sel
                       (_SelectIf "\nSelect Object to Label: "
                           (function
                               (lambda ( x )
                                   (or
                                       (eq "VERTEX" (cdr (assoc 0 (entget x))))
                                       (_CurveObject-p x)
                                   )
                               )
                           )
                       )
                   )
               )
           )
           (princ "\n*Cancel*")
       )
       (   (null
               (or
                   (and
                       (setq mat (caddr sel))
                       (setq ent (_CopyNested (car sel) mat))
                   )
                   (and
                       (eq "VERTEX" (cdr (assoc 0 (entget (car sel)))))
                       (setq ent (cdr (assoc 330 (entget (car sel)))))
                   )
                   (setq ent (car sel))
               )
           )
           (princ "\nUnable to Recreate Nested Entity.")
       )
       (   t
           (setq obj
               (vla-addmtext acspc
                   (vlax-3D-point
                       (vlax-curve-getclosestpointto ent (trans (cadr sel) 1 0))
                   )
                   0.0 *str*
               )
           )
           (vla-put-attachmentpoint obj acattachmentpointmiddlecenter)
           (vla-put-backgroundfill  obj *bak*)
           (setq msg (princ "\nAlign Label: [+/-] for [O]ffset, [P]erpendicular, [b]ackground Mask"))

           (while
               (progn
                   (setq gr (grread 't 15 0)
                         g1 (car  gr)
                         g2 (cadr gr)
                   )
                   (cond
                       (   (member g1 '(5 3))
                           (setq p2 (trans g2 1 0)
                                 p1 (vlax-curve-getclosestpointto ent p2)
                           )
                           (if (not (equal p1 p2 1e-10))
                               (progn
                                   (setq di (/ (* factor *off*) (distance p1 p2)))
                                   (vla-put-insertionpoint obj (vlax-3D-point (mapcar '(lambda ( a b ) (+ a (* (- b a) di))) p1 p2)))
                                   (vla-put-rotation obj (_MakeReadable (+ (angle (trans p1 0 1) g2) *per*)))
                               )
                           )
                           (= 5 g1)
                       )
                       (   (= 2 g1)
                           (cond
                               (   (member g2 '(80 112)) ; P/p
                                   (setq *per* (- (/ pi 2.) *per*))
                               )
                               (   (member g2 '(45  95)) ; -/_
                                   (setq *off* (- *off* 0.1))
                               )
                               (   (member g2 '(43  61)) ; +/=
                                   (setq *off* (+ *off* 0.1))
                               )
                               (   (member g2 '(66  98)) ; B/b
                                   (vlax-put obj 'backgroundfill (setq *bak* (~ (vlax-get obj 'backgroundfill))))
                                   (if (zerop *bak*)
                                       (princ "\n<Background Mask Off>")
                                       (princ "\n<Background Mask On>")
                                   )
                                   (princ msg)
                               )
                               (   (member g2 '(79 111)) ; O/o
                                   (setq *off*
                                       (cond
                                           (   (setq d (getdist (strcat "\nSpecify Label Offset <" (rtos (* *off* factor)) "> : ")))
                                               (/ d factor)
                                           )
                                           (   *off*   )
                                       )
                                   )
                                   (princ msg)
                               )
                               (   (member g2 '(13 32))
                                   nil
                               )
                               (   t   )
                           )
                       )
                   )
               )
           )            
           (if mat (entdel ent))
       )
   )
   (_EndUndo acdoc)
   (princ)
)
(vl-load-com)
(princ
   (strcat
       "\n:: Label.lsp | Version 1.1 | © Lee Mac "
       (menucmd "m=$(edtime,$(getvar,DATE),YYYY)")
       " www.lee-mac.com ::"
       "\n:: Type \"Label\" to Invoke ::"
   )
)
(princ)

 

 

Similarly I was wondering if it's possible to alter the "Align Text" lisp so that when you click on the text it adopts the layer of the line/curve you're aligning it to:

 

(defun c:atc

   (
       /
       *error*
       ang
       bak
       cfg
       dcl def dis
       ent enx
       gr1 gr2
       hgt
       jus
       mat msg mtp
       nrm
       off
       pi2 prn prp pt1 pt2
       red rot
       sav sel str sym
       tmp txt typ
       uxa
   )

   (defun *error* ( msg )
       (if
           (and
               (= 'list (type def))
               (= 'str  (type cfg))
               (findfile cfg)
           )
           (atc:writeconfig cfg (mapcar 'eval (mapcar 'car def)))
       )
       (if
           (and
               (= 'vla-object (type txt))
               (not (vlax-erased-p txt))
               (vlax-write-enabled-p txt)
           )
           (if (= 'list (type prp))
               (foreach x prp
                   (if (vlax-property-available-p txt (car x) t)
                       (vl-catch-all-apply 'vlax-put-property (cons txt x))
                   )
               )
               (vl-catch-all-apply 'vla-delete (list txt))
           )
       )
       (if
           (and
               (= 'list  (type mat))
               (= 'ename (type ent))
               (entget ent)
           )
           (entdel ent)
       )
       (atc:endundo (atc:acdoc))
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (atc:startundo (atc:acdoc))
   (cond
       (   (or (atc:layerlocked (getvar 'clayer))
               (atc:layerlocked "0")
           )
           (princ "\nCurrent layer or layer \"0\" locked.")
       )
       (   (null (vl-file-directory-p (setq sav (atc:savepath))))
           (princ "\nSave path invalid.")
       )
       (   (progn
               (setq def
                  '(
                       (typ . "txt")
                       (jus . "Middle-Center")
                       (off . 1.0)
                       (rot . 0.0)
                       (red . t)
                       (bak . nil)
                       (mtp . nil)
                   )
               )
               (setq cfg (strcat sav "\\LMAC_ATC_V" (vl-string-translate "." "-" atc:version) ".cfg")
                     dcl (strcat sav "\\LMAC_ATC_V" (vl-string-translate "." "-" atc:version) ".dcl")
               )
               (if (not (findfile cfg))
                   (atc:writeconfig cfg (mapcar 'cdr def))
               )
               (atc:readconfig cfg (setq sym (mapcar 'car def)))

               (while
                   (progn
                       (setvar 'errno 0)
                       (initget "New Settings Exit")
                       (setq sel (entsel "\nSelect text to align [New/Settings] <Exit>: "))
                       (cond
                           (   (= 7 (getvar 'errno))
                               (princ "\nMissed, try again.")
                           )
                           (   (= 'list (type sel))
                               (setq ent (car sel)
                                     enx (entget ent)
                               )
                               (cond
                                   (   (not (wcmatch (cdr (assoc 0 enx)) "TEXT,MTEXT"))
                                       (princ "\nObject must be either Text or MText.")
                                   )
                                   (   (atc:layerlocked (cdr (assoc 8 enx)))
                                       (princ "\nObject is on a locked layer.")
                                   )
                                   (   t
                                       (setq txt (vlax-ename->vla-object ent)
                                             prp (atc:getproperties txt)
                                       )
                                       nil
                                   )
                               )
                           )
                           (   (= "Exit" sel)
                               nil
                           )
                           (   (= "Settings" sel)
                               (mapcar 'set sym (atc:settings dcl (mapcar 'eval sym)))
                           )
                           (   (= "New" sel)
                               (= "" (vl-string-trim " \t\n" (setq str (getstring t "\nSpecify text <Select>: "))))
                           )
                       )
                   )
               )
               (not
                   (or (= 'vla-object (type txt))
                       (and (= 'str (type str)) (/= "" (vl-string-trim " \t\n" str)))
                   )
               )
           )
           (atc:writeconfig cfg (mapcar 'eval sym))
       )
       (   (progn
               (while
                   (progn
                       (setvar 'errno 0)
                       (setq sel (nentselp "\nSelect curve to align text <Exit>: "))
                       (cond
                           (   (= 7 (getvar 'errno))
                               (princ "\nMissed, try again.")
                           )
                           (   (= 'ename (type (car sel)))
                               (if
                                   (not
                                       (or (= "VERTEX" (cdr (assoc 0 (entget (car sel)))))
                                           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list (car sel)))))
                                       )
                                   )
                                   (princ "\nInvalid object selected.")
                               )
                           )
                       )
                   )
               )
               (null sel)
           )
       )
       (   (not
               (or
                   (and
                       (setq mat (caddr sel))
                       (setq ent (atc:copynested (car sel) mat))
                   )
                   (and
                       (= "VERTEX" (cdr (assoc 0 (entget (car sel)))))
                       (setq ent (cdr (assoc 330 (entget (car sel)))))
                   )
                   (setq ent (car sel))
               )
           )
           (princ "\nUnable to recreate nested entity.")
       )
       (   t
           (if (null txt)
               (if (= "txt" typ)
                   (progn
                       (setq txt
                           (vla-addtext
                               (vlax-get-property (atc:acdoc)
                                   (if (= 1 (getvar 'cvport))
                                       'paperspace
                                       'modelspace
                                   )
                               )
                               str
                               (vlax-3D-point (trans (cadr sel) 1 0))
                               (atc:styleheight (getvar 'textstyle))
                           )
                       )
                       (vla-put-alignment txt
                           (eval
                               (cadr
                                   (assoc jus
                                      '(
                                           ("Left"          acalignmentleft)
                                           ("Center"        acalignmentcenter)
                                           ("Right"         acalignmentright)
                                           ("Middle"        acalignmentmiddle)
                                           ("Top-Left"      acalignmenttopleft)
                                           ("Top-Center"    acalignmenttopcenter)
                                           ("Top-Right"     acalignmenttopright)
                                           ("Middle-Left"   acalignmentmiddleleft)
                                           ("Middle-Center" acalignmentmiddlecenter)
                                           ("Middle-Right"  acalignmentmiddleright)
                                           ("Bottom-Left"   acalignmentbottomleft)
                                           ("Bottom-Center" acalignmentbottomcenter)
                                           ("Bottom-Right"  acalignmentbottomright)
                                       )
                                   )
                               )
                           )
                       )
                   )
                   (progn
                       (setq txt
                           (vla-addmtext
                               (vlax-get-property (atc:acdoc)
                                   (if (= 1 (getvar 'cvport))
                                       'paperspace
                                       'modelspace
                                   )
                               )
                               (vlax-3D-point (trans (cadr sel) 1 0))
                               (   (lambda ( box ) (- (caadr box) (caar box)))
                                   (textbox
                                       (list
                                           (cons 01 (strcat str "."))
                                           (cons 40 (atc:styleheight (getvar 'textstyle)))
                                           (cons 07 (getvar 'textstyle))
                                       )
                                   )
                               )
                               str
                           )
                       )
                       (vla-put-attachmentpoint txt
                           (eval
                               (cadr
                                   (assoc jus
                                      '(
                                           ("Top-Left"      acattachmentpointtopleft)
                                           ("Top-Center"    acattachmentpointtopcenter)
                                           ("Top-Right"     acattachmentpointtopright)
                                           ("Middle-Left"   acattachmentpointmiddleleft)
                                           ("Middle-Center" acattachmentpointmiddlecenter)
                                           ("Middle-Right"  acattachmentpointmiddleright)
                                           ("Bottom-Left"   acattachmentpointbottomleft)
                                           ("Bottom-Center" acattachmentpointbottomcenter)
                                           ("Bottom-Right"  acattachmentpointbottomright)
                                       )
                                   )
                               )
                           )
                       )
                       (vla-put-height txt (atc:styleheight (getvar 'textstyle)))
                       (if bak (vla-put-backgroundfill txt :vlax-true))
                   )
               )
           )
           (if
               (and
                   (= "AcDbText" (vla-get-objectname txt))
                   (/= acalignmentleft (vla-get-alignment txt))
               )
               (setq prn 'textalignmentpoint)
               (setq prn 'insertionpoint)
           )
           (setq hgt (vla-get-height txt)
                 pi2 (/ pi -2.0)
                 nrm (trans '(0.0 0.0 1.0) 1 0 t)
                 uxa (if (= "AcDbText" (vla-get-objectname txt)) (angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 nrm t)) 0.0)
                 msg (strcat "\n[+/-] for [O]ffset | [</>] for [R]otation | Readabilit[y] |"
                         (if (= "AcDbMText" (vla-get-objectname txt))
                             " [b]ackground Mask | <[E]xit>: "
                             " <[E]xit>: "
                         )
                     )
           )
           (princ msg)
           (while
               (progn
                   (setq gr1 (grread t 15 0)
                         gr2 (cadr gr1)
                         gr1 (car  gr1)
                   )
                   (cond
                       (   (or (= 5 gr1) (= 3 gr1))
                           (setq pt2 (trans gr2 1 0)
                                 pt1 (vlax-curve-getclosestpointto ent pt2)
                           )
                           (if (not (equal pt1 pt2 1e-)
                               (progn
                                   (setq dis (/ (* hgt off) (distance pt1 pt2))
                                         ang (+ (angle (trans pt1 0 1) gr2) uxa rot pi2)
                                   )
                                   (vlax-put-property txt prn (vlax-3D-point (mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt1 pt2)))
                                   (vla-put-rotation  txt (if red (atc:readable ang) ang))
                               )
                           )
                           (cond
                               (   (= 5 gr1))
                               (   mtp
                                   (setq txt (vla-copy txt)
                                         prp nil
                                   )
                                   t
                               )
                           )
                       )
                       (   (= 2 gr1)
                           (cond
                               (   (member gr2 '(043 061))
                                   (setq off (+ off 0.1))
                               )
                               (   (member gr2 '(045 095))
                                   (setq off (- off 0.1))
                               )
                               (   (member gr2 '(044 060))
                                   (setq rot (+ rot (/ pi 4.0)))
                               )
                               (   (member gr2 '(046 062))
                                   (setq rot (- rot (/ pi 4.0)))
                               )
                               (   (member gr2 '(013 032 069 101))
                                   (*error* nil)
                                   nil
                               )
                               (   (member gr2 '(089 121))
                                   (if (setq red (not red))
                                       (princ "\n<Text Readability Enabled>")
                                       (princ "\n<Text Readability Disabled>")
                                   )
                                   (princ msg)
                               )
                               (   (member gr2 '(066 098))
                                   (if (= "AcDbMText" (vla-get-objectname txt))
                                       (progn
                                           (vlax-put txt 'backgroundfill (~ (vlax-get txt 'backgroundfill)))
                                           (if (setq bak (= -1 (vlax-get txt 'backgroundfill)))
                                               (princ "\n<Background Mask On>")
                                               (princ "\n<Background Mask Off>")
                                           )
                                       )
                                       (princ "\nBackground mask only available with MText.")
                                   )
                                   (princ msg)
                               )
                               (   (member gr2 '(082 114))
                                   (if (setq tmp (getangle (strcat "\nSpecify Rotation <" (angtos rot) ">: ")))
                                       (setq rot tmp)
                                   )
                                   (princ msg)
                               )
                               (   (member gr2 '(079 111))
                                   (if (setq tmp (getdist (strcat "\nSpecify Offset <" (rtos (* hgt off)) ">: ")))
                                       (setq off (/ tmp hgt))
                                   )
                                   (princ msg)
                               )
                               (   t   )
                           )
                       )
                       (   (member gr1 '(11 25))
                           (*error* nil)
                           nil
                       )
                       (   t   )
                   )
               )
           )
           (if mat (entdel ent))
           (atc:writeconfig cfg (mapcar 'eval sym))
       )
   )
   (atc:endundo (atc:acdoc))
   (princ)
)

;;----------------------------------------------------------------------;;

(defun atc:readable ( a )
   (   (lambda ( a )
           (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
               (atc:readable (+ a pi))
               a
           )
       )
       (rem (+ a pi pi) (+ pi pi))
   )
)

;;----------------------------------------------------------------------;;

(defun atc:styleheight ( sty / tmp )
   (if (zerop (setq tmp (cdr (assoc 40 (tblsearch "style" sty)))))
       (setq tmp (getvar 'textsize))
   )
   (if (atc:annotative-p sty)
       (/ tmp (cond ((getvar 'cannoscalevalue)) (1.0)))
       tmp
   )
)

;;----------------------------------------------------------------------;;

(defun atc:annotative-p ( sty )
   (and
       (setq sty (tblobjname "style" sty))
       (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
       (= 1 (cdr (assoc 1070 (reverse sty))))
   )
)

;;----------------------------------------------------------------------;;

(defun atc:copynested ( ent mat / enx tmp )
   (if (= 1 (cdr (assoc 66 (setq enx (entget ent)))))
       (progn
           (atc:entmakex enx)
           (setq ent (entnext ent)
                 enx (entget  ent)
           )
           (while (/= "SEQEND" (cdr (assoc 0 enx)))
               (atc:entmakex enx)
               (setq ent (entnext ent)
                     enx (entget  ent)
               )
           )
           (setq tmp (cdr (assoc 330 (entget (atc:entmakex enx)))))
       )
       (setq tmp (atc:entmakex enx))
   )
   (if tmp (vla-transformby (vlax-ename->vla-object tmp) (vlax-tmatrix mat)))
   tmp
)

;;----------------------------------------------------------------------;;

(defun atc:entmakex ( enx )
   (entmakex
       (append
           (vl-remove-if
               (function
                   (lambda ( x )
                       (or (member (car x) '(005 006 008 039 048 062 102 370))
                           (= 'ename (type (cdr x)))
                       )
                   )
               )
               enx
           )
          '(
               (006 . "CONTINUOUS")
               (008 . "0")
               (039 . 0.0)
               (048 . 1.0)
               (062 . 7)
               (370 . 0)
           )
       )
   )
)

;;----------------------------------------------------------------------;;

(defun atc:getproperties ( obj )
   (vl-remove nil
       (mapcar
           (function
               (lambda ( prp )
                   (if (vlax-property-available-p obj prp t)
                       (list prp (vlax-get-property obj prp))
                   )
               )
           )
          '(
               insertionpoint
               textalignmentpoint
               backgroundfill
               rotation
           )
       )
   )
)

;;----------------------------------------------------------------------;;

(defun atc:settings ( dcl lst / *error* alg bak dch jus mtp off off:str red rot rot:str typ typ:fun )

   (defun *error* ( msg )
       (if (< 0 dch)
           (unload_dialog dch)
       )
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (cond
       (   (not (atc:writedcl dcl))
           (princ "\nDCL file could not be written.")
       )
       (   (<= (setq dch (load_dialog dcl)) 0)
           (princ "\nDCL file could not be loaded.")
       )
       (   (not (new_dialog "atc" dch))
           (princ "\nProgram dialog could not be loaded.")
       )
       (   t
           (mapcar 'set '(typ jus off rot red bak mtp) lst)
           
           (set_tile typ "1")
           (
               (setq typ:fun
                   (lambda ( typ )
                       (setq alg (atc:justlist typ))
                       (set_tile "jus"
                           (itoa
                               (cond
                                   (   (vl-position jus alg))
                                   (   (setq jus (car alg)) 0)
                               )
                           )
                       )
                       (if (= "mtx" typ)
                           (mode_tile "bak" 0)
                           (mode_tile "bak" 1)
                       )
                   )
               )
               typ
           )
           (action_tile "jus" "(setq jus (nth (atoi $value) alg))")
           (action_tile "txt" "(typ:fun (setq typ $key))")
           (action_tile "mtx" "(typ:fun (setq typ $key))")

           (set_tile    "off"  (setq off:str (rtos off)))
           (action_tile "off" "(setq off:str $value)")

           (set_tile    "rot"  (setq rot:str (angtos rot)))
           (action_tile "rot" "(setq rot:str $value)")

           (foreach key '("red" "bak" "mtp")
               (set_tile    key (if (eval (read key)) "1" "0"))
               (action_tile key (strcat "(setq " key " (= \"1\" $value))"))
           )
           (action_tile "accept"
               (vl-prin1-to-string
                  '(cond
                       (   (not (distof off:str))
                           (alert "\nOffset Factor must be numerical.")
                           (mode_tile "off" 2)
                       )
                       (   (not (angtof rot:str))
                           (alert "\nText Rotation must be numerical.")
                           (mode_tile "rot" 2)
                       )
                       (   (setq off (distof off:str)
                                 rot (angtof rot:str)
                           )
                           (done_dialog 1)
                       )
                   )
               )
           )
        
           (if (= 1 (start_dialog))
               (setq lst (list typ jus off rot red bak mtp))
           )
       )
   )
   (if (< 0 dch)
       (unload_dialog dch)
   )
   lst
)

;;----------------------------------------------------------------------;;

(defun atc:justlist ( typ / lst )
   (start_list "jus")
   (foreach itm
       (setq lst
           (append
               (if (= "txt" typ)
                  '(
                       "Left"
                       "Center"
                       "Right"
                       "Middle"
                   )
               )
              '(
                   "Top-Left"
                   "Top-Center"
                   "Top-Right"
                   "Middle-Left"
                   "Middle-Center"
                   "Middle-Right"
                   "Bottom-Left"
                   "Bottom-Center"
                   "Bottom-Right"
               )
           )
       )
       (add_list itm)
   )
   (end_list)
   lst
)

;;----------------------------------------------------------------------;;

(defun atc:layerlocked ( lay / def )
   (and
       (setq def (tblsearch "layer" lay))
       (= 4 (logand 4 (cdr (assoc 70 def))))
   )
)

;;----------------------------------------------------------------------;;

(defun atc:writedcl ( dcl / des )
   (cond
       (   (findfile dcl))
       (   (setq des (open dcl "w"))
           (foreach x
              '(
                   "edt : edit_box"
                   "{"
                   "    edit_width = 8;"
                   "    edit_limit = 10;"
                   "    alignment = left;"
                   "}"
                   "atc : dialog"
                   "{"
                   "    label = \"Settings\";"
                   "    spacer;"
                   "    : text"
                   "    {"
                   "        label = \"Object type for new text:\";"
                   "    }"
                   "    : radio_row"
                   "    {"
                   "        alignment = centered;"
                   "        fixed_width = true;"
                   "        : radio_button"
                   "        {"
                   "            key = \"txt\";"
                   "            label = \"Text\";"
                   "        }"
                   "        : radio_button"
                   "        {"
                   "            key = \"mtx\";"
                   "            label = \"MText\";"
                   "        }"
                   "    }"
                   "    spacer;"
                   "    : text"
                   "    {"
                   "        label = \"Justification for new text:\";"
                   "    }"
                   "    : popup_list"
                   "    {"
                   "        key = \"jus\";"
                   "    }"
                   "    spacer;"
                   "    : edt"
                   "    {"
                   "        key = \"off\";"
                   "        label = \"Offset Factor:\";"
                   "    }"
                   "    : edt"
                   "    {"
                   "        key = \"rot\";"
                   "        label = \"Text Rotation:\";"
                   "    }"
                   "    spacer;"
                   "    : toggle"
                   "    {"
                   "        key = \"red\";"
                   "        label = \"Retain Text Readability\";"
                   "    }"
                   "    : toggle"
                   "    {"
                   "        key = \"bak\";"
                   "        label = \"MText Background Mask\";"
                   "    }"
                   "    : toggle"
                   "    {"
                   "        key = \"mtp\";"
                   "        label = \"Multiple Text Mode\";"
                   "    }"
                   "    spacer;"
                   "    ok_cancel;"
                   "}"
               )
               (write-line x des)
           )
           (setq des (close des))
           (while (not (findfile dcl)))
           dcl
       )
   )
)

;;----------------------------------------------------------------------;;

(defun atc:writeconfig ( cfg lst / _tostring des )

   (defun _tostring ( x / dim )
       (cond
           (   (= 'int (type x))
               (itoa x)
           )
           (   (= 'real (type x))
               (setq dim (getvar 'dimzin))
               (setvar 'dimzin 0)
               (setq x (rtos x 2 )
               (setvar 'dimzin dim)
               x
           )
           (   (vl-prin1-to-string x))
       )
   )
   
   (if (setq des (open cfg "w"))
       (progn
           (foreach x lst (write-line (_tostring x) des))
           (setq des (close des))
           t
       )
   )
)

;;----------------------------------------------------------------------;;

(defun atc:readconfig ( cfg lst / des itm )
   (if
       (and
           (setq cfg (findfile cfg))
           (setq des (open cfg "r"))
       )
       (progn
           (foreach sym lst
               (if (setq itm (read-line des))
                   (set  sym (read itm))
               )
           )
           (setq des (close des))
           t
       )
   )
)

;;----------------------------------------------------------------------;;

(defun atc:savepath ( / tmp )
   (if (setq tmp (getvar 'roamablerootprefix))
       (strcat (atc:fixdir tmp) "\\Support")
       (atc:fixdir (getvar 'tempprefix))
   )
)

;;----------------------------------------------------------------------;;

(defun atc:fixdir ( dir )
   (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
)

;;----------------------------------------------------------------------;;

(defun atc:startundo ( doc )
   (atc:endundo doc)
   (vla-startundomark doc)
)

;;----------------------------------------------------------------------;;

(defun atc:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)

;;----------------------------------------------------------------------;;

(defun atc:acdoc nil
   (eval (list 'defun 'atc:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (atc:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
   (strcat
       "\n:: AlignTextToCurve.lsp | Version "
       atc:version
       " | \\U+00A9 Lee Mac "
       (menucmd "m=$(edtime,0,yyyy)")
       " www.lee-mac.com ::"
       "\n:: Type \"atc\" to Invoke ::"
   )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

Thanks in advance!

Link to comment
Share on other sites

OK well I've (finally) solved the top one with a macro which changes the layer, fires up the label lisp, then reverts to the previous layer. Hurrah :D If it helps anyone else out it's

 

^C^Clayer;set;MISC_TEXT;^CLB;\\layerp;

 

(Note I've changed the lisp command to "LB" from "label")

 

Still totally stumped by the second one if anyone can help?!

Link to comment
Share on other sites

If you are not familiar with it, Lee has the awesome Layer Director lisp (which I have in my Startup Suite),

which basically does what you are trying to do with your layers, you might want to check it out.

If the layer you have specified doesn't exist, it will create it too, then go back to the previous layer after the lisp has finished.

 

Thanks Lee! :beer:

Link to comment
Share on other sites

I do have that and it's brilliant, yes (what would we do without him?). I've set it up so that when I write some new text it automatically puts it on to our generic text layer MISC_TEXT, and then I can fire up the ATC lisp and align it to my linework. PERFECT :thumbsup:

 

However sometimes we don't want the text to be on MISC_TEXT but on the same layer as the object to which it relates. I just wondered if it was possible to alter the code so that when you use ATC to align the text to a line it also adopts its layer properties all in one click. I think this would be something that would need writing into the lisp but it's totally beyond me. Not that Match Properties is arduous or anything, I just thought it worth an ask!

Link to comment
Share on other sites

Actually Dadgad maybe you can help me out with the Layer Director... I've tried to add a couple of lisps to it but they're not working. As an example, I've added "EM" - the Elevation Marker lisp (another Lee Mac original) - but when I enter the command it's still putting it on the current layer rather than the "LEVELS" one I want it on. I've not actually tried to use it to control lisps before, only native autocad commands, am I doing something wrong?

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...