Couldn't get the styles part working on my PC maybe because of differences in our setups.
Modified leader2.lsp with (styles) commented out attached. It requires qlset.lsp (Frank Whaley, Autodesk) attached as well.
;;--------------------------------------Sub Function to Create Styles-----------------------------------------------------
; (load "leader2.lsp") vc
;| (defun Styles()
;create text Style
(if (not (tblsearch "style" "Gen-Text")) (command "-style" "Gen-Text" "Arial.ttf" "A""yes" "No" 2.5 "1" 0 "n" "n"))
;create dimension style
(if (not (tblsearch "DImstyle" "Dim Arrow Ann"))
(progn
(command "dim" "style" "Gen-Text"
"DIMADEC" 0
"DIMALT" 0
"DIMALTD" 2
"DIMALTF" 1.00
"DIMALTRND" 0.00
"DIMALTTD" 2
"DIMALTTZ" 0
"DIMALTU" 2
"DIMALTZ" 0
"DIMASZ" 3
"DIMATFIT" 3
"DIMAUNIT" 0
"DIMAZIN" 0
"DIMBLK" "_CLOSEd"
"DIMBLK1" ""
"DIMBLK2" ""
"DIMLDRBLK" "_closed"
"DIMCEN" 0
"DIMCLRD" 1
"DIMCLRE" 1
"DIMCLRT" 2
"DIMDEC" 2
"DIMDLE" 0.00
"DIMDLI" 1.00
"DIMDSEP" ""
"DIMEXE" 1.50
"DIMEXO" 1.50
"DIMFRAC" 0
"DIMGAP" 1.00
"DIMJUST" 0
"DIMLFAC" 1000.00
"DIMLIM" 0
"DIMLUNIT" 2
"DIMLWD" 0
"DIMLWE" 0
"DIMRND" 0.00
"DIMSAH" 0
"DIMSCALE" 1.00
"DIMSD1" 0
"DIMSD2" 0
"DIMSE1" 0
"DIMSE2" 0
"DIMSOXD" 0
"DIMTAD" 0
"DIMTDEC" 0
"DIMTIH" 0
"DIMTIX" 0
"DIMTM" 0.00
"DIMTMOVE" 0
"DIMTOFL" 0
"DIMTOH" 0
"DIMTSZ" 0.00
"DIMTVP" 0.00
"DIMTXSTY" "RomanS"
"DIMTXT" 2.50
"DIMZIN" 0
"DIMFIT" 5 /e)
(command "dimstyle" "An" "y" "Dim Arrow Ann" "S" "")
) ;progn
) ;if
) ;defun
|;
;;-------------------------------------------Set Datum-----------------------------------------------------
(defun C:dat (/ num op sta pga stb pgb)
(command "cmdecho"0)
(command "ucs" "w")
;;; input station
(if (not nf-ns) (setq nf-ns 0.000)) ; default number
(setq NUM (getreal (strcat "\nEnter station <" (rtos nf-ns 2 3) ">: ")))
(if (not num) (setq num nf-ns) (setq nf-ns num))
;;; input pgl
(if (not sf-ss) (setq sf-ss 0.000)) ; default number
(setq SUM (getreal (strcat "\nEnter profile datum <" (rtos sf-ss 2 3) ">: ")))
(if (not sum) (setq sum sf-ss) (setq sf-ss sum))
;;; set orign point
(setq op (getpoint "\nPick datum orgin point: "))
(setq sta (car op))
(setq pga (cadr op))
(setq stb (- sta num))
(setq pgb (- pga sum))
(command "ucs" "m" (list stb pgb 0))
(prompt "\nOrigin moved to new loaction - Enter Command vc to place Text")
(princ)
) ;defun
;;-------------------------------------------Place Text----------------------------------------------------
(defun C:VC (/ *error* enp1 ex ey dy ptl e TextObj vlText)
(defun *Error* (msg) ; embedded defun
(setvar "clayer" clay)
(acet-ql-set (list(cons 67 vrtcs))) ;reset maximum # of points to previous value
(if (/= s "Function cancelled")
(princ (strcat "\nError: " msg))
)
(princ)
)
(command "cmdecho"0)
(setq clay (getvar "clayer"))
(or acet-ql-get (load "qlset.lsp"))
(if (not (tblsearch "layer" "Text Coordinate")) (command "-LAYER" "N" "Text Coordinate" "C" "7" "Text Coordinate" "LT" "Continuous" "Text Coordinate""LW" "0.15" "Text Coordinate" ""))
; (Styles)
(command "CLAYER" "Text Coordinate")
; (command "-DIMSTYLE" "r" "Dim Arrow Ann")
(setq enp1 (getpoint "\nPick Coordinate point: ")
ELstr (strcat "EL.=" (rtos(cadr enp1) 2 3))
)
(setq vrtcs (cdr(assoc 67(acet-ql-get))))
(acet-ql-set '((67 . 2))) ;set maximum # of points to 2
(princ "\nmaximum # of points = ")
(princ (cdr(assoc 67(acet-ql-get))))
(princ "\nMText width (word wrap) (default=1) = ")
(princ (cdr(assoc 68(acet-ql-get))))
(princ "\nSpecify leader start point:")
(if(= 1(cdr(assoc 68(acet-ql-get)))); prompt for MText width (word wrap) (default=1)
(command "qleader" enp1 PAUSE "0" "VERT. C.V." ELstr "")
(command "qleader" enp1 PAUSE "VERT. C.V." ELstr "")
)
(princ "\n(logand 1 (getvar "cmdactive")) = ")
(princ (logand 1 (getvar "cmdactive")))
(while (= 1 (logand 1 (getvar "cmdactive")))
(command (getstring T "Enter Leader Text: "))
) ;null responce exits text
(acet-ql-set (list(cons 67 vrtcs))) ;reset maximum # of points to previous value
(princ)
) ; defun
;;----------------------------------------Back to UCS World-----------------------------------------------------
(defun C:uw ()
(command "ucs" "w")
(prompt "\nUCS Origin is set to World")
(princ)
) ; defun
qlset.lsp
;|
qlset.lsp - example initialization of QLEADER settings
Frank Whaley, Autodesk
Two functions are included in this file:
(acet-ql-get)
Returns an association list containing the current QLEADER settings from the
Named Object Dictionary.
(acet-ql-get <alist>)
Sets the specified values for QLEADER settings from the given association
list.
Returns an association list containing the new values.
These functions can be used to examine the current QLEADER settings, or to
initialize the setting before using the QLEADER command.
For example, to use splined leaders and framed text:
(acet-ql-set '((65 . 1)(72 . 1)))
Both functions use the following group codes to identify QLEADER settings:
3: user arrowhead block name (default="")
40: default text width (default=0.0)
60: annotation type (default=0)
0=MText
1=copy object
2=Tolerance
3=block
4=none
61: annotation reuse (default=0)
0=none
1=reuse next
62: left attachment point (default=1)
63: right attachment point (default=3)
0=Top of top line
1=Middle of top line
2=Middle of multiline text
3=Middle of bottom line
4=Bottom of bottom line
64: underline bottom line (default=0)
65: use splined leader line (default=0)
66: no limit on points (default=0)
67: maximum number of points (default=3)
68: prompt for MText width (word wrap) (default=1)
69: always left justify (default=0)
70: allowed angle, first segment (default=0)
71: allowed angle, second segment (default=0)
0=Any angle
1=Horizontal
2=90deg
3=45deg
4=30deg
5=15deg
72: frame text (default=0)
170: active tab (default=0)
0=Annotation
1=Leader Line & Arrow
2=Attachment
340: object ID for annotation reuse
|;
(defun acet-ql-get (/ xr cod itm reply)
(if (setq xr (dictsearch (namedobjdict) "AcadDim"))
(progn
(foreach cod '(3 40 60 61 62 63 64 65 66 67 68 69 70 71 72 170 340)
(if (setq itm (assoc cod xr))
(setq reply (append reply (list itm)))))
reply)
'((3 . "")
(40 . 0.0)
(60 . 0)
(61 . 1)
(62 . 1)
(63 . 3)
(64 . 0)
(65 . 0)
(66 . 0)
(67 . 3)
(68 . 1)
(69 . 0)
(70 . 0)
(71 . 0)
(72 . 0)
(170 . 0))))
(defun acet-ql-set (arg / cur prm)
;; fetch current
(setq cur (acet-ql-get))
;; override per argument
(while arg
(setq prm (car arg)
arg (cdr arg)
cur (subst prm (assoc (car prm) cur) cur) )
;; handle DIMLDRBLK
(if (= 3 (car prm))
(setvar "DIMLDRBLK" (cdr prm))))
;; put back
(dictremove (namedobjdict) "AcadDim")
(setq cur (append '((0 . "XRECORD")(100 . "AcDbXrecord")(90 . 990106))cur))
(dictadd (namedobjdict) "AcadDim" (entmakex cur))
(acet-ql-get))
;; load quietly
(princ)