Torro Posted July 30, 2014 Share Posted July 30, 2014 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! Quote Link to comment Share on other sites More sharing options...
Torro Posted July 31, 2014 Author Share Posted July 31, 2014 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 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?! Quote Link to comment Share on other sites More sharing options...
Dadgad Posted July 31, 2014 Share Posted July 31, 2014 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! Quote Link to comment Share on other sites More sharing options...
Torro Posted July 31, 2014 Author Share Posted July 31, 2014 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 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! Quote Link to comment Share on other sites More sharing options...
Torro Posted July 31, 2014 Author Share Posted July 31, 2014 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? Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.