Send all IMAGES, OLE’s and PDF’s to back in one click


;;; Send all IMAGES, OLE's and PDF's to back in one click
;;; Created by Willie https://www.theswamp.org/index.php?action=profile;u=1474
;;; Saved from here: https://www.theswamp.org/index.php?topic=52967.0
;;; Slightly modified by Igal Averbuh 2017 (added option for PDF's and OLE's)

(defun c:HAB (/)
(setvar "cmdecho" 0)
(setq SS_IMAGE nil)
(setq SS_IMAGE (ssget "X" '((0 . "IMAGE,OLE2FRAME,PDFUNDERLAY"))))
(if (= SS_IMAGE nil)
(princ "\nNo images in drawing")

(progn
(command "draworder" SS_IMAGE "" "back" )
(setvar "cmdecho" 1)

(princ "\n *** All IMAGES, OLE's and PDF's moved to back !! ***")

);progn
);if
(princ)
);defun
(c:hab)

Unexplode Polylines


;;; Unexplode Polylines
;;; Based on Lee Mak routines saved from: http://www.cadtutor.net/forum/showthread.php?92452-convert-lines-to-polyline-(where-endpoints-coincide)
;;; Combined by Igal Averbuh 2017

;;--------------------=={ Chain Selection }==-----------------;;
;; ;;
;; Prompts the user to select an object and generates a ;;
;; selection chain of all objects sharing endpoints with ;;
;; objects in the accumulative selection. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - http://www.lee-mac.com ;;
;;------------------------------------------------------------;;

(defun c:pj ( / *error* sel val var )

(defun *error* ( msg )
(mapcar '(lambda ( a b ) (if b (setvar a b))) var val)
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel
(LM:ssget "\nPolyline was Unexploded "
'( "_:L"
(
(-4 . "<OR")
(0 . "LINE,ARC")
(-4 . "")
(-4 . "OR>")
)
)
)
)
(progn
(setq var '(cmdecho peditaccept)
val (mapcar 'getvar var)
)
(mapcar '(lambda ( a b c ) (if a (setvar b c))) val var '(0 1))
(command "_.pedit" "_m" sel "" "_j" "" "")
)
)
(*error* nil)
(princ)
)

(defun c:ccp ( / en fl in l1 l2 s1 s2 sf vl )
(setq sf
(list
'(-4 . "<OR")
'(0 . "LINE,ARC")
'(-4 . "")
'(-4 . "")
'(-4 . "<AND")
'(0 . "ELLIPSE")
'(-4 . "")
'(-4 . "AND>")
'(-4 . "OR>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
(if (setq s1 (ssget "_X" sf))
(if (setq en (ssget "_+.:E:S" sf))
(progn
(setq s2 (ssadd)
en (ssname en 0)
l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
)
(repeat (setq in (sslength s1))
(setq en (ssname s1 (setq in (1- in)))
vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
)
)
(while
(progn
(foreach v vl
(if (vl-some '(lambda ( p ) (or (equal (car v) p 1e-8) (equal (cadr v) p 1e-8))) l1)
(setq s2 (ssadd (caddr v) s2)
l1 (vl-list* (car v) (cadr v) l1)
fl t
)
(setq l2 (cons v l2))
)
)
fl
)
(setq vl l2 l2 nil fl nil)
)
)
)
(princ "\nNo valid objects found.")
)
(sssetfirst nil s2)
(princ)
)
(vl-load-com) (princ)

(defun c:up ( / )
(c:ccp)
(c:pj)
)
(c:up)

Match Properties (Grrr Dialog box version)


; My Match Properties - Created by Grrr
; Saved from: https://www.theswamp.org/index.php?topic=52951.0

(defun C:MMP ( / tgassoc tgswitch *error* dcl des dch dcf tmp L SS tmpL i o )

; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T):
(defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) ; Grrr

; Toggle switcher - switch toggle's value
(defun tgswitch ( key ) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0")))))) ; Grrr

(defun *error* ( msg )
(and (>\"; fixed_width = true; width = 2; }"
" }"
" : row "
" { : text { label = \"Destination objects\"; }"
" : button { key = \"db\"; label = \">>\"; fixed_width = true; width = 2; }"
" }"
" }"
" : spacer { height = 1; }"
(if L
(strcat
" : column"
" { children_fixed_width = true; children_alignment = left;"
" : text { label = \"Properties To Match\"; } spacer;"
(apply 'strcat (mapcar (function (lambda (x) (strcat ": toggle { label = \"" (car x) "\"; key = \"" (car x) "\"; value = 1; }"))) L))
" spacer;"
" : button { label = \"Switch Toggles\"; key = \"Switch\"; mnemonic = \"t\"; }"
" spacer;"
" }"
); strcat
" : text { label = \"Source object not specified!\"; alignment = centered; }"
); if L
" : spacer { height = 1; }"
" ok_cancel; : text { key = \"error\"; }"
"}"
); list
); vl-every
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(princ "\nUnable to write or load the DCL file.") (setq dcf 0)
)
( (not (new_dialog "MyMatchProps" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) )
(T
(if tmpL (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpL)) ; remember (restore) chosen toggles between sessions.
(vl-every (function (lambda (x) (action_tile (car x) (strcat "(done_dialog " (itoa (cadr x)) ")")))) '(("sb" 2) ("db" 3))) ; button actions
(action_tile "Switch"
(vl-prin1-to-string
'(progn
(mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car L))
(setq tmpL (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car L)))
); progn
); vl-prin1-to-string
); action_tile
(if L
(vl-every ; toggle actions
(function
(lambda (x)
(action_tile (car x)
(vl-prin1-to-string
'(cond
( (assoc $key tmpL) (setq tmpL (subst (cons $key $value) (assoc $key tmpL) tmpL)) )
( (setq tmpL (cons (cons $key $value) tmpL)) )
); cond
); vl-prin1-to-string
); action_tile
); lambda
); function
L
); vl-every
); if L
(action_tile "accept"
(vl-prin1-to-string
'(cond
( (not L) (set_tile "error" "Check the above message - Grrr.") )
( (not SS) (set_tile "error" "Destination objects not specified!") )
( (setq L (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) L)) ; end result of L
(done_dialog 1)
)
); cond
); vl-prin1-to-string
); action_tile
(setq dcf (start_dialog))
); T
); cond
(cond
( (= 2 dcf)
(and
(setq tmp
(
(lambda (x / p)
(setvar 'errno 0)
(while (/= 52 (getvar 'errno)) (setq p (car (entsel "\nSelect Source Object : ")))
(cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again!") (setvar 'errno 0) )
(p (setq p (vlax-ename->vla-object p)) (setvar 'errno 52) )
); cond
); while
p
); lambda
nil
)
); setq tmp
(setq L ; I care about only this list here
(apply 'append
(mapcar (function (lambda (x) (if (vlax-property-available-p tmp x) (list (list x (vlax-get tmp x))))))
'("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"
"EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height"
"AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"
"XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor"
); list
); mapcar
); apply 'append
); setq L
); and
); (= 2 dcf)
( (= 3 dcf) (and (princ "\nSelect Destination Objects: ") (setq tmp (ssget "_:L")) (setq SS tmp) ) ); (= 3 dcf)
); cond
); while
(/= 1 dcf)
); progn
(princ "\nUser cancelled the dialog.")
)
( (and L SS)
(setq L (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) L))
(repeat (setq i (sslength SS))
(and (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) (vlax-write-enabled-p o)
(mapcar
(function
(lambda (x)
(and (vlax-property-available-p o (car x)) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x))))
); lambda
); function
L
); mapcar
); and
); repeat
; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) L))) ; check
; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) tmpL))) ; check
); T
); cond
(*error* nil) (princ)
);
(c:mmp)

Standard ‘Measure’ command however centering the divisions along the selected object


(defun c:GetBlkName (/ ent)
(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))
)))

;;-------------------=={ Centered Measure }==-----------------;;
;; ;;
;; Emulates the behaviour of the standard 'Measure' command ;;
;; however centering the divisions along the selected object ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - http://www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Slightly modified by Igal Averbuh 2017
(defun c:cm ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm pt )

(defun *error* ( msg )
(if acdoc (_EndUndo acdoc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)

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

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

(defun _SelectIf ( msg pred func / sel ) (setq pred (eval pred))
(while
(progn (setvar 'ERRNO 0) (setq sel (car (func msg)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, Try again.")
)
( (eq 'ENAME (type sel))
(if (and pred (not (pred sel)))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
sel
)

(defun _IsCurveObject ( entity / param )
(and
(not
(vl-catch-all-error-p
(setq param
(vl-catch-all-apply 'vlax-curve-getendparam (list entity))
)
)
)
param
)
)

(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
nm (trans '(0. 0. 1.) 1 0 t)
)
(if (setq en (_SelectIf "\nSelect Object to Measure: " '_isCurveObject entsel))
(progn
(initget 7 "Block")
(setq di (getdist "\nSpecify length of segment or [Block]: "))

(if (eq "Block" di)

(progn

(c:GetBlkName)

(while

(progn (setq bl (getstring t "\nEnter name of block to insert: "))
(cond
( (not (snvalid bl))
(princ "\nInvalid block name.")
)
( (not (tblsearch "BLOCK" bl))
(princ (strcat "\nCannot find block \"" bl "\"."))
)
)
)
)
(initget "Yes No")
(setq al (not (eq "No" (getkword "\nAlign block with object? [Yes/No] : "))))
(initget 7)
(setq di (getdist "\nSpecify length of segment: "))
)
)
(setq mx (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
)
(_StartUndo acdoc)
(while (and (<= (setq d0 (+ d0 di)) mx) (setq pt (vlax-curve-getpointatdist en d0)))
(if bl
(entmakex
(list
(cons 0 "INSERT")
(cons 2 bl)
(cons 10 (trans pt 0 nm))
(cons 50
(if al
(angle '(0. 0. 0.)
(trans
(vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt)) 0 nm
)
)
0.
)
)
(cons 210 nm)
)
)
(entmakex (list (cons 0 "POINT") (cons 10 pt)))
)
)
(_EndUndo acdoc)
)
(princ "\n*Cancel*")
)
(princ)
)
(vl-load-com) (princ)

;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
(c:cm)

Measure LINEs, SPLINEs, LWPOLYLINEs and POLYLINEs by user selected aligned Block


;;; Measure LINEs, SPLINEs, LWPOLYLINEs and POLYLINEs by user selected aligned Block
;;; Saved from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-routine-using-the-measure-command/td-p/5562007

(defun c:meb (/ blk ss l name)
; TharwaT 04. 04. 2011
(if
(and (setq blk (entsel "\nSelect Block:"))
(princ "\nSelect Objects to Measure: ")
(setq ss (ssget "_:L" '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE"))))
(setq l (getdist "\nDistance between Blocks :"))
)
(progn
(setq name (cdr (assoc 2 (entget (car blk)))))
((lambda (i / ss1)
(while
(setq ss1 (ssname ss (setq i (1+ i))))
(command "_.measure" ss1 "Block" name "_Y" l)
)
)
-1
)
)
(princ)
)
(princ)
)
(c:meb)

Change width to all segments in a selection of polylines


;; Polyline Width - Lee Mac
;; Applies a given constant width to all segments in a selection of polylines.

(defun c:pw ( / *error* idx sel wid )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel (LM:ssget "\nSelect polylines: " '("_:L" ((0 . "LWPOLYLINE,POLYLINE")))))

;(setq sel (ssget "X" (list '(0 . "LWPOLYLINE"))))

(progn
(initget 4)
;(setq wid 0.0)
(setq wid (getdist "\nEnter New Width: "))
(repeat (setq idx (sslength sel))
(vla-put-constantwidth (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) wid)
)
)
)
(*error* nil)
(princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

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

;; End Undo - Lee Mac
;; Closes an Undo Group.

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

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
(c:pw)

One Point Leader Mirror across Vertical axis, with Object Snap for selection


; One Point Leader Mirror across Vertical axis, with Object Snap for selection
; Slightly modified by Igal Averbuh 2017 (added option for leader sellection only)
; Based on Kent Cooper's one point Mirror across Vertical axis, with Object Snap for selection

(defun c:MV (/ pt)
(setvar "osmode" 2)

(setq pt (ssget "_:L" '((0 . "LEADER"))))
(princ "\nSelect Mirror Point:")
(setvar "cmdecho" 0)
(setq pt (getpoint))
(command
"_.mirror"
pt ""
"_none" "@"
"_none" "@0,1"
"_yes"
)
(setvar "osmode" 167)
(setvar "cmdecho" 1)
)

Linear Texts and Attributes Interpolation in a Horizontal plan


; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
; Modified by Master Kent Cooper 2017 (added option for Attributes and nested texts)
; Saved from here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/linear-interpolation-problem/m-p/6962404/highlight/false#M351363
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Text Height : ")))
((getvar 'textsize))
)
)

(setq GL1 (nentsel "\nSelect First Boundary Text Value:"))

(setq Lvl1 (entget (car GL1)))

(setq G_val1 (assoc 1 Lvl1))

(setq GL2 (nentsel "\nSelect Second Boundary Text Value:"))

(setq Lvl2 (entget (car GL2)))

(setq G_Val2 (assoc 1 Lvl2))

(setq p1 (getpoint "Pick Point Range From:"))
(setq d (getdist p1 "Pick Point Range To:"))
(setq d (float d))

(setq slp1 (- (atof(cdr G_val2)) (atof(cdr G_val1))))
(setq slp (/ slp1 d))

(while
(setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
(setq d1 (distance p1 Txt_pnt))
(setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp)))
(setq val1 (rtos new_lvl 2 2))
(command "text" Txt_pnt "" "" val1)
)
)
(c:hi)

Linear Interpolation in a Horizontal plan


; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Text Height : ")))
((getvar 'textsize))
)
)

(while (not
(setq GL1 (entsel "\nSelect First Boundary Text Value:"))
))
(setq Lvl1 (entget (car GL1)))

(if (> (length Lvl1) 22)
(setq G_val1 (nth 13 Lvl1))

(setq G_Val1 (nth 11 Lvl1))
)

(while (not
(setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
))
(setq Lvl2 (entget (car GL2)))

(if (> (length Lvl2) 22)
(setq G_val2 (nth 13 Lvl2))

(setq G_Val2 (nth 11 Lvl2))
)

(setq p1 (getpoint "Pick Point Range From:"))
(setq d (getdist p1 "Pick Point Range To:"))
(setq d (float d))

(setq slp1 (- (atof(cdr G_val2)) (atof(cdr G_val1))))
(setq slp (/ slp1 d))

(while
(setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
(setq d1 (distance p1 Txt_pnt))
(setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp)))
(setq val1 (rtos new_lvl 2 3))
(command "text" Txt_pnt "" "" val1)
)
)
(c:hi)

Automatic Coordinate Labeling (Draw Leader with X,Y coordinates in 000-Coordinates Labels layer)


;;; Automatic Coordinate Labeling (Draw Leader with X,Y coordinates in 000-Coordinates Labels layer)
;;; User can define: Leader Arrow Head Size, Coordinates Text Height and Coordinates Text Location
;;; Created by Igal Averbuh 2017
;;;Based on C.Gingerich and Edwin Prakoso Programs.

(defun c:XY (/ txtsz st midpt endpt htxts ang1 ang2 pt1 pt2 scle
arblk tsize)

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Coordinates Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Coordinates Labels"))

(setvar "cmdecho" 1)

(setq st nil
midpt nil
endpt nil)
(defun *error* (ms)
(setvar "orthomode" *ortho)
(setq tsize (getvar "textsize"))
(princ ms)
(princ)
)
(setvar "cmdecho" 0)
(setq tsize (getvar "textsize"))
(setq *ortho (getvar "orthomode"))
(setq scle (getvar "dimscale"))
(setvar "orthomode" 0)

(setvar 'DIMASZ
(cond ((getdist (strcat "\nSpecify Leader Arrow Head Size : ")))
((getvar 'DIMASZ))
)
)

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Coordinates Text Height : ")))
((getvar 'textsize))
)
)

(while
(setvar "orthomode" 0)
(setq st (getpoint "\nPick Coordinates Point: "))

(if (= st nil)(exit))
(setq midpt (getpoint st))
(setvar "orthomode" 1)
(if (= midpt nil)(exit))
(setq endpt (getpoint midpt))
(if (= endpt nil)(exit))
(command "leader" st midpt endpt "" "" "n")
(setvar "orthomode" *ortho)

(setq textloc (getpoint "\nPick Coordinates Text Location: "))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setq x (rtos (car st)))
(setq y (rtos (cadr st)))
; (setq ptcoord (strcat "X= " x " " "Y= " y))
(setq ptcoordx (strcat "X= " x))
(setq ptcoordy (strcat "Y= " y))
(command "_.text" "j" "bl" textloc "" "" ptcoordx )
(command "_.text" "" ptcoordy)

)
)
;(c:xy)