ONLY BY CHANCE..
So far seems to work....... slow learner
here's the pgm: 'tests desired'
(defun getlength (curveobj / len)
(setq len 0.0)
(vl-catch-all-apply '(lambda ()
(setq len
(vlax-curve-getdistatparam curveobj
(vlax-curve-getendparam curveobj)
)
)
)
)
len
)
;; https://www.theswamp.org/index.php?topic=39512.msg447762#msg447762
(defun TEST (/ ) ;; line only select
(while
(progn
(initget "Exit ")
(if (setq OB (entsel "\n Select Line Arc for Midpoint..<exit>: "))
(cond
( (or (= OB "Exit") (= OB ""))
(princ "\n>> Exit TEST routine. <<")
nil
)
( (or (/= (setq DT (cdr (assoc 0 (entget (car OB))))) "LINE"
(setq DT (cdr (assoc 0 (entget (car OB))))) "ARC"))
(princ "\n** Wrong object selected **")
T
)
( (= DT "ARC")
(setq DT OB)
;;(princ "\n>> You select a line. <<") ;; was
nil
)
( (= DT "LINE")
(setq DT OB)
;;(princ "\n>> You select a line. <<")
nil
) )
(progn
(princ "\n** Nothing selected **")
T
)
)
)
)
(princ)
)
(defun c:gmp ( / *error* ss arc-length arc-obj arcmidxyz w77) ;; getarcmidpoint
(defun *error* ( msg )
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(setvar 'cmdecho 1)
(princ)
)
(princ "\n Mid.Point and Coords of Line.. < last.picked.coords: 'cds': >")
(while
(setvar 'cmdecho 0)
(command "UCS" "Save" "w77") ;; save current ucs..
(command "UCS" "W")
(test) ;; line arc only select
(setq arc-obj (vlax-ename->vla-object (car DT)) ;; use line from 'test' filter
arc-length (getLength arc-obj)
arcmidxyz (vlax-curve-getPointAtDist arc-obj (* arc-length 0.5))
)
(setq cds (strcat ;; cmd/copy usable coords
(rtos (car arcmidxyz) 2 5)","
(rtos (cadr arcmidxyz) 2 5)","
(rtos (caddr arcmidxyz) 2 5)
)
)
(princ (strcat "\n" cds)) ;;
(command "point" arcmidxyz) ;; to place point..
(command "UCS" "Restore" "w77" "UCS" "Del" "W77") ;; restored/deletes ucs..
)
(setvar 'cmdecho 1)
(*error* nil)
(princ)
)