Distance between two intersections

Hello,

I couldn't find it anywhere so i'm posting new thread. Has anyone come across this kind of lisp:

I have 3 lines of which 2 are parallel to each other and the third one intersects both of them (each one in one random point of ocurse ) And now, when i click anywhere on the intersecting line (between the two intersections) my action results in putting there a text/mtext parallel to the intersecting line with distance value between these 2 intersections.

Sorry if my explanation isn't clear enough but english isn't my 1st language

thanks in advance for any help

Why not to use standard tools AutoSAD?

_dimaligned (the parallel dimension) if the text adjust style is necessary to you only, having suppressed all lines and arrows, having left only the text

The thing is I have close to 100 (sometomes more) that kind of intersections ( this is a ground profile and a profile with acoustic screens along the road. Pillars of the screens are located in distances berween each other about 4-5 meters (this is my intersecting line - pillar axis). I'm using standard cad tools all the time but I think that clicking once is always better than doing it 3 times to achieve the same goal

Give this a shot:

Not 100% foolproof for intersection number > 2.

Lee

Actually this is better, select the CurveObject between the intersections that you want to measure.

For Non-linear objects, the distance is measured as the path traversed by that object between the points - not the straight line distance.

(defun c:int_dist (/

                  *error*
                  isCurveObj ss->list
                  vlax-list->3D-point
                  SortFromPt
                  
                  DIST
                  ENT
                  ILST
                  LANG
                  MA MI MPT
                  OBJ
                  PT
                  SS
                  TOBJ
                  UFLAG
                  
                  )
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))


 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   ) ;_  or
   (princ)
 ) ;_  defun


 (defun isCurveObj (ent)
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function
           vlax-curve-getEndParam
         ) ;_  function
         (list ent)
       ) ;_  vl-catch-all-apply
     ) ;_  vl-catch-all-error-p
   ) ;_  not
 ) ;_  defun



 (defun ss->list (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst
            (cons
              (vlax-ename->vla-object ent)
              Objlst
            ) ;_  cons
     ) ;_  setq
   ) ;_  while
   ObjLst
 ) ;_  defun


 (defun vlax-list->3D-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst))
     ) ;_  cons
   ) ;_  if
 ) ;_  defun


 (defun SortFromPt (pt lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (distance a pt)
                   (distance b pt)
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun


 (while
   (progn
     (setq ent (entsel)
           pt  (cadr ent)
           ent (car ent)
     ) ;_  setq

     (cond ((eq 'ENAME (type ent))

            (if (isCurveObj ent)
              (progn

                (vla-getBoundingBox
                  (setq obj
                         (vlax-ename->vla-object ent)
                  ) ;_  setq
                  'Mi
                  'Ma
                ) ;_  vla-getBoundingBox

                (mapcar
                  (function set)
                  '(Mi Ma)
                  (mapcar
                    (function
                      vlax-safearray->list
                    ) ;_  function
                    (list Mi Ma)
                  ) ;_  mapcar
                ) ;_  mapcar

                (setq ss
                       (ssget "_C"
                              (list (car Mi) (cadr Ma) 0.)
                              (list (car Ma) (cadr Mi) 0.)
                       ) ;_  ssget
                ) ;_  setq

                (if
                  (and
                    (setq iLst
                           (apply
                             (function
                               append
                             ) ;_  function
                             (vl-remove 'nil
                                        (mapcar
                                          (function
                                            (lambda (x)
                                              (vlax-list->3D-point
                                                (vlax-invoke
                                                  obj
                                                  'IntersectWith
                                                  x
                                                  acExtendNone
                                                ) ;_  vlax-invoke
                                              ) ;_  vlax-list->3D-point
                                            ) ;_  lambda
                                          ) ;_  function
                                          (ss->list
                                            (ssdel ent ss)
                                          ) ;_  ss->list
                                        ) ;_  mapcar
                             ) ;_  vl-remove
                           ) ;_  apply
                    ) ;_  setq
                    (< 1 (length iLst))
                  ) ;_  and

                   (progn

                     (setq uFlag
                            (not
                              (vla-StartUndoMark *doc)
                            ) ;_  not
                     ) ;_  setq

                     (setq iLst (SortFromPt
                                  (vlax-curve-getClosestPointto ent pt)
                                  iLst
                                ) ;_  SortFromPt

                           iLst (list (car iLst) (cadr iLst))
                     ) ;_  setq

                     (setq mPt
                            (vlax-curve-getPointatDist
                              ent
                              (/
                                (+
                                  (vlax-curve-getDistatPoint
                                    ent
                                    (cadr iLst)
                                  ) ;_  vlax-curve-getDistatPoint
                                  (vlax-curve-getDistAtPoint
                                    ent
                                    (car ilst)
                                  ) ;_  vlax-curve-getDistAtPoint
                                ) ;_  -

                                2.
                              ) ;_  /
                            ) ;_  vlax-curve-getPointatDist
                     ) ;_  setq

                     (setq dist
                            (abs
                              (-
                                (vlax-curve-getDistatPoint
                                  ent
                                  (cadr iLst)
                                ) ;_  vlax-curve-getDistatPoint
                                (vlax-curve-getDistAtPoint
                                  ent
                                  (car ilst)
                                ) ;_  vlax-curve-getDistAtPoint
                              ) ;_  -
                            ) ;_  abs
                     ) ;_  setq

                     (setq lAng
                            (angle '(0 0 0)
                                   (vlax-curve-getFirstDeriv
                                     ent
                                     (vlax-curve-getParamatPoint
                                       ent
                                       mPt
                                     ) ;_  vlax-curve-getParamatPoint
                                   ) ;_  vlax-curve-getFirstDeriv
                            ) ;_  angle
                     ) ;_  setq

                     (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                            (setq lAng (- lAng pi))
                           )
                           ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                            (setq lAng (+ lAng pi))
                           )
                     ) ;_  cond

                     (setq tObj
                            (vla-AddText
                              (if
                                (zerop
                                  (vla-get-ActiveSpace *doc)
                                ) ;_  zerop
                                 (if
                                   (eq :vlax-true
                                       (vla-get-MSpace *doc_)
                                   ) ;_  eq
                                    (vla-get-ModelSpace *doc)
                                    (vla-get-PaperSpace *doc)
                                 ) ;_  if
                                 (vla-get-ModelSpace *doc)
                              ) ;_  if
                              (rtos dist)
                              (vlax-3D-point
                                '(0 0 0)
                              ) ;_  vlax-3D-point
                              (getvar 'TEXTSIZE)
                            ) ;_  vla-AddText
                     ) ;_  setq

                     (vla-put-Alignment tObj acAlignmentMiddleCenter)

                     (vla-put-TextAlignmentPoint
                       tObj
                       (vlax-3D-point
                         (polar mPt
                                (+ lAng (/ pi 2.))
                                (getvar 'TEXTSIZE)
                         ) ;_  polar
                       ) ;_  vlax-3D-point
                     ) ;_  vla-put-TextAlignmentPoint

                     (vla-put-rotation tObj lAng)

                     (setq uFlag
                            (vla-EndUndomark *doc)
                     ) ;_  setq
                   ) ;_  progn

                   (princ "\n** Object Has less than Two Intersections **")

                ) ;_  if
              ) ;_  progn

              (princ "\n** Invalid Object Selected **")
            ) ;_  if
           )
     ) ;_  cond
   ) ;_  progn
 ) ;_  while

 (princ)
) ;_  defun

maybe I'm doing something wrong, but both codes return this

** Error: bad argument type: VLA-OBJECT nil **

Doesn't seem to matter if picked objects are lines, polylines (1 segment) splines or anything else.

They seem to work for me...

This may better suit you:

(defun c:int_dist (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt SortbyParam

                    DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y
                  )
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))


 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   ) ;_  or
   (princ)
 ) ;_  defun


 (defun isCurveObj (ent)
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function
           vlax-curve-getEndParam
         ) ;_  function
         (list ent)
       ) ;_  vl-catch-all-apply
     ) ;_  vl-catch-all-error-p
   ) ;_  not
 ) ;_  defun



 (defun ss->list (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst
            (cons
              (vlax-ename->vla-object ent)
              Objlst
            ) ;_  cons
     ) ;_  setq
   ) ;_  while
   ObjLst
 ) ;_  defun


 (defun vlax-list->3D-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst))
     ) ;_  cons
   ) ;_  if
 ) ;_  defun


 (defun SortFromPt (pt lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (distance a pt)
                   (distance b pt)
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun


 (defun SortByParam (ent lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (vlax-curve-getParamatPoint
                     ent
                     a
                   ) ;_  vlax-curve-getParamatPoint
                   (vlax-curve-getParamatPoint
                     ent
                     b
                   ) ;_  vlax-curve-getParamatPoint
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun


 (while
   (progn
     (setq ent (car (entsel)))

     (cond ((eq 'ENAME (type ent))

            (if (isCurveObj ent)
              (progn

                (vla-getBoundingBox
                  (setq obj
                         (vlax-ename->vla-object ent)
                  ) ;_  setq
                  'Mi
                  'Ma
                ) ;_  vla-getBoundingBox

                (mapcar
                  (function set)
                  '(Mi Ma)
                  (mapcar
                    (function
                      vlax-safearray->list
                    ) ;_  function
                    (list Mi Ma)
                  ) ;_  mapcar
                ) ;_  mapcar

                (setq ss
                       (ssget "_C"
                              (list (car Mi) (cadr Ma) 0.)
                              (list (car Ma) (cadr Mi) 0.)
                       ) ;_  ssget
                ) ;_  setq

                (if
                  (and
                    (setq iLst
                           (apply
                             (function
                               append
                             ) ;_  function
                             (vl-remove 'nil
                                        (mapcar
                                          (function
                                            (lambda (x)
                                              (vlax-list->3D-point
                                                (vlax-invoke
                                                  obj
                                                  'IntersectWith
                                                  x
                                                  acExtendNone
                                                ) ;_  vlax-invoke
                                              ) ;_  vlax-list->3D-point
                                            ) ;_  lambda
                                          ) ;_  function
                                          (ss->list
                                            (ssdel ent ss)
                                          ) ;_  ss->list
                                        ) ;_  mapcar
                             ) ;_  vl-remove
                           ) ;_  apply
                    ) ;_  setq
                    (< 1 (length iLst))
                  ) ;_  and

                   (progn

                     (setq uFlag
                            (not
                              (vla-StartUndoMark *doc)
                            ) ;_  not
                     ) ;_  setq

                     (setq iLst (SortByParam
                                  ent
                                  iLst
                                ) ;_  SortFromPt
                     ) ;_  setq

                     (or
                       (equal
                         (vlax-curve-getStartParam ent)
                         (vlax-curve-getParamatPoint
                           ent
                           (car iLst)
                         ) ;_  vlax-curve-getParamatPoint
                         0.001
                       ) ;_  equal
                       (setq iLst
                              (cons
                                (vlax-curve-getStartPoint ent)
                                iLst
                              ) ;_  cons
                       ) ;_  setq
                     ) ;_  or

                     (or
                       (equal
                         (vlax-curve-getEndParam ent)
                         (vlax-curve-getParamatPoint
                           ent
                           (last iLst)
                         ) ;_  vlax-curve-getParamatPoint
                         0.001
                       ) ;_  equal
                       (setq iLst
                              (append iLst
                                      (list
                                        (vlax-curve-getEndPoint ent)
                                      ) ;_  list
                              ) ;_  append
                       ) ;_  setq
                     ) ;_  or

                     (while
                       (cadr iLst)

                        (setq x (car iLst)
                              y (cadr iLst)
                        ) ;_  setq

                        (setq mPt
                               (vlax-curve-getPointatDist
                                 ent
                                 (/
                                   (+
                                     (vlax-curve-getDistatPoint
                                       ent
                                       y
                                     ) ;_  vlax-curve-getDistatPoint
                                     (vlax-curve-getDistAtPoint
                                       ent
                                       x
                                     ) ;_  vlax-curve-getDistAtPoint
                                   ) ;_  -

                                   2.
                                 ) ;_  /
                               ) ;_  vlax-curve-getPointatDist
                        ) ;_  setq

                        (setq dist
                               (abs
                                 (-
                                   (vlax-curve-getDistatPoint
                                     ent
                                     y
                                   ) ;_  vlax-curve-getDistatPoint
                                   (vlax-curve-getDistAtPoint
                                     ent
                                     x
                                   ) ;_  vlax-curve-getDistAtPoint
                                 ) ;_  -
                               ) ;_  abs
                        ) ;_  setq

                        (setq lAng
                               (angle '(0 0 0)
                                      (vlax-curve-getFirstDeriv
                                        ent
                                        (vlax-curve-getParamatPoint
                                          ent
                                          mPt
                                        ) ;_  vlax-curve-getParamatPoint
                                      ) ;_  vlax-curve-getFirstDeriv
                               ) ;_  angle
                        ) ;_  setq

                        (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                               (setq lAng (- lAng pi))
                              )
                              ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                               (setq lAng (+ lAng pi))
                              )
                        ) ;_  cond

                        (setq tObj
                               (vla-AddText
                                 (if
                                   (zerop
                                     (vla-get-ActiveSpace *doc)
                                   ) ;_  zerop
                                    (if
                                      (eq :vlax-true
                                          (vla-get-MSpace *doc_)
                                      ) ;_  eq
                                       (vla-get-ModelSpace *doc)
                                       (vla-get-PaperSpace *doc)
                                    ) ;_  if
                                    (vla-get-ModelSpace *doc)
                                 ) ;_  if
                                 (rtos dist)
                                 (vlax-3D-point
                                   '(0 0 0)
                                 ) ;_  vlax-3D-point
                                 (getvar 'TEXTSIZE)
                               ) ;_  vla-AddText
                        ) ;_  setq

                        (vla-put-Alignment tObj acAlignmentMiddleCenter)

                        (vla-put-TextAlignmentPoint
                          tObj
                          (vlax-3D-point
                            (polar mPt
                                   (+ lAng (/ pi 2.))
                                   (getvar 'TEXTSIZE)
                            ) ;_  polar
                          ) ;_  vlax-3D-point
                        ) ;_  vla-put-TextAlignmentPoint

                        (vla-put-rotation tObj lAng)

                        (setq iLst (cdr iLst))
                     ) ;_  while

                     (setq uFlag
                            (vla-EndUndomark *doc)
                     ) ;_  setq
                   ) ;_  progn

                   (princ "\n** Object Has less than Two Intersections **")

                ) ;_  if
              ) ;_  progn

              (princ "\n** Invalid Object Selected **")
            ) ;_  if
           )
     ) ;_  cond
   ) ;_  progn
 ) ;_  while

 (princ)
) ;_  defun

Thanks, this one seem to do the trick Although not on my cad (i keep on getting the same error as previously). But (there's always but ) is it possibie to

1) add a option or constantly limit the code to give only one value of the nearest intersections? Sometimes I have many lines in one direction and would have to manually remove other unnecessary values

2) set the accuracy to 2 decimal places

3) set text font/scale from my current dimension style

Lee, you forgot to define the document.

(or *doc (setq *doc (vla-get-activedocument (vlax-get-acad-object))))

Decide to change your code formatting?

1) add a option or constantly limit the code to give only one value of the nearest intersections? Sometimes I have many lines in one direction and would have to manually remove other unnecessary values

This is what my previous code does.

2) set the accuracy to 2 decimal places

This is currently set by your LUPREC Sys Var, but I can also change it manually in the code.

3) set text font/scale from my current dimension style

The code currently uses your TextStyle settings, but yes, I can change this.

Lee, you forgot to define the document.

 

(or *doc (setq *doc (vla-get-activedocument (vlax-get-acad-object))))

Decide to change your code formatting?

Ahhhh! Rookie error! No wonder I didn't notice it! Thanks dude

Thought I'd experiment with my style

Thought I'd experiment with my style

Kerry give you too much of a hard time. :wink:

And to think of all the times you ragged on me for this style formatting.

Kerry give you too much of a hard time. :wink:

 

And to think of all the times you ragged on me for this style formatting.

Well, spurred on from Kerry's comments I thoughts I'd see how it would look - but I don't like it to be honest, so I'll probably go back to my old style.

Ok, previous code updated to reflect Alan's bug spot

Give it a try now Pontifex

This should perform as required:

(defun c:int_dist (/

                  *error*
                  isCurveObj ss->list
                  vlax-list->3D-point
                  SortFromPt
                  
                  DIST
                  ENT
                  ILST
                  LANG
                  MA MI MPT
                  OBJ
                  PT
                  SS
                  TOBJ
                  UFLAG
                  
                  )
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))


 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   ) ;_  or
   (princ)
 ) ;_  defun


 (defun isCurveObj (ent)
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function
           vlax-curve-getEndParam
         ) ;_  function
         (list ent)
       ) ;_  vl-catch-all-apply
     ) ;_  vl-catch-all-error-p
   ) ;_  not
 ) ;_  defun



 (defun ss->list (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst
            (cons
              (vlax-ename->vla-object ent)
              Objlst
            ) ;_  cons
     ) ;_  setq
   ) ;_  while
   ObjLst
 ) ;_  defun


 (defun vlax-list->3D-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst))
     ) ;_  cons
   ) ;_  if
 ) ;_  defun


 (defun SortFromPt (pt lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (distance a pt)
                   (distance b pt)
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun


 (while
   (progn
     (setq ent (entsel)
           pt  (cadr ent)
           ent (car ent)
     ) ;_  setq

     (cond ((eq 'ENAME (type ent))

            (if (isCurveObj ent)
              (progn

                (vla-getBoundingBox
                  (setq obj
                         (vlax-ename->vla-object ent)
                  ) ;_  setq
                  'Mi
                  'Ma
                ) ;_  vla-getBoundingBox

                (mapcar
                  (function set)
                  '(Mi Ma)
                  (mapcar
                    (function
                      vlax-safearray->list
                    ) ;_  function
                    (list Mi Ma)
                  ) ;_  mapcar
                ) ;_  mapcar

                (setq ss
                       (ssget "_C"
                              (list (car Mi) (cadr Ma) 0.)
                              (list (car Ma) (cadr Mi) 0.)
                       ) ;_  ssget
                ) ;_  setq

                (if
                  (and
                    (setq iLst
                           (apply
                             (function
                               append
                             ) ;_  function
                             (vl-remove 'nil
                                        (mapcar
                                          (function
                                            (lambda (x)
                                              (vlax-list->3D-point
                                                (vlax-invoke
                                                  obj
                                                  'IntersectWith
                                                  x
                                                  acExtendNone
                                                ) ;_  vlax-invoke
                                              ) ;_  vlax-list->3D-point
                                            ) ;_  lambda
                                          ) ;_  function
                                          (ss->list
                                            (ssdel ent ss)
                                          ) ;_  ss->list
                                        ) ;_  mapcar
                             ) ;_  vl-remove
                           ) ;_  apply
                    ) ;_  setq
                    (< 1 (length iLst))
                  ) ;_  and

                   (progn

                     (setq uFlag
                            (not
                              (vla-StartUndoMark *doc)
                            ) ;_  not
                     ) ;_  setq

                     (setq iLst (SortFromPt
                                  (vlax-curve-getClosestPointto ent pt)
                                  iLst
                                ) ;_  SortFromPt

                           iLst (list (car iLst) (cadr iLst))
                     ) ;_  setq

                     (setq mPt
                            (vlax-curve-getPointatDist
                              ent
                              (/
                                (+
                                  (vlax-curve-getDistatPoint
                                    ent
                                    (cadr iLst)
                                  ) ;_  vlax-curve-getDistatPoint
                                  (vlax-curve-getDistAtPoint
                                    ent
                                    (car ilst)
                                  ) ;_  vlax-curve-getDistAtPoint
                                ) ;_  -

                                2.
                              ) ;_  /
                            ) ;_  vlax-curve-getPointatDist
                     ) ;_  setq

                     (setq dist
                            (abs
                              (-
                                (vlax-curve-getDistatPoint
                                  ent
                                  (cadr iLst)
                                ) ;_  vlax-curve-getDistatPoint
                                (vlax-curve-getDistAtPoint
                                  ent
                                  (car ilst)
                                ) ;_  vlax-curve-getDistAtPoint
                              ) ;_  -
                            ) ;_  abs
                     ) ;_  setq

                     (setq lAng
                            (angle '(0 0 0)
                                   (vlax-curve-getFirstDeriv
                                     ent
                                     (vlax-curve-getParamatPoint
                                       ent
                                       mPt
                                     ) ;_  vlax-curve-getParamatPoint
                                   ) ;_  vlax-curve-getFirstDeriv
                            ) ;_  angle
                     ) ;_  setq

                     (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                            (setq lAng (- lAng pi))
                           )
                           ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                            (setq lAng (+ lAng pi))
                           )
                     ) ;_  cond

                     (setq tObj
                            (vla-AddText
                              (if
                                (zerop
                                  (vla-get-ActiveSpace *doc)
                                ) ;_  zerop
                                 (if
                                   (eq :vlax-true
                                       (vla-get-MSpace *doc)
                                   ) ;_  eq
                                    (vla-get-ModelSpace *doc)
                                    (vla-get-PaperSpace *doc)
                                 ) ;_  if
                                 (vla-get-ModelSpace *doc)
                              ) ;_  if
                              (rtos dist 2 2)
                              (vlax-3D-point
                                '(0 0 0)
                              ) ;_  vlax-3D-point
                              (getvar 'TEXTSIZE)
                            ) ;_  vla-AddText
                     ) ;_  setq

                     (vla-put-Alignment tObj acAlignmentMiddleCenter)

                     (vla-put-TextAlignmentPoint
                       tObj
                       (vlax-3D-point
                         (polar mPt
                                (+ lAng (/ pi 2.))
                                (getvar 'TEXTSIZE)
                         ) ;_  polar
                       ) ;_  vlax-3D-point
                     ) ;_  vla-put-TextAlignmentPoint

                     (vla-put-StyleName tObj (getvar 'DIMTXSTY))

                     (vla-put-rotation tObj lAng)

                     (setq uFlag
                            (vla-EndUndomark *doc)
                     ) ;_  setq
                   ) ;_  progn

                   (princ "\n** Object Has less than Two Intersections **")

                ) ;_  if
              ) ;_  progn

              (princ "\n** Invalid Object Selected **")
            ) ;_  if
           )
     ) ;_  cond
   ) ;_  progn
 ) ;_  while

 (princ)
) ;_  defun

Lee, if you use MText, you can avoid the worry of dealing with annotative text. If you did want to use DText, you could just check to see if the style is annotative then use this instead...

(* (/ 1 (getvar 'cannoscalevalue)) (getvar 'textsize))

Food for thought.

With MText...

(defun c:test (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt SortbyParam DIST ENT
              ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y
             )
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10


 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   ) ;_  or
   (princ)
 ) ;_  defun


 (defun isCurveObj (ent)
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function
           vlax-curve-getEndParam
         ) ;_  function
         (list ent)
       ) ;_  vl-catch-all-apply
     ) ;_  vl-catch-all-error-p
   ) ;_  not
 ) ;_  defun



 (defun ss->list (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst
            (cons
              (vlax-ename->vla-object ent)
              Objlst
            ) ;_  cons
     ) ;_  setq
   ) ;_  while
   ObjLst
 ) ;_  defun


 (defun vlax-list->3D-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst))
     ) ;_  cons
   ) ;_  if
 ) ;_  defun


 (defun SortFromPt (pt lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (distance a pt)
                   (distance b pt)
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun


 (defun SortByParam (ent lst)
   (vl-sort lst
            (function
              (lambda (a b)
                (< (vlax-curve-getParamatPoint
                     ent
                     a
                   ) ;_  vlax-curve-getParamatPoint
                   (vlax-curve-getParamatPoint
                     ent
                     b
                   ) ;_  vlax-curve-getParamatPoint
                ) ;_  <
              ) ;_  lambda
            ) ;_  function
   ) ;_  vl-sort
 ) ;_  defun

 (or *doc (setq *doc (vla-get-activedocument (vlax-get-acad-object))))

 (while
   (progn
     (setq ent (car (entsel)))

     (cond ((eq 'ENAME (type ent))

            (if (isCurveObj ent)
              (progn

                (vla-getBoundingBox
                  (setq obj
                         (vlax-ename->vla-object ent)
                  ) ;_  setq
                  'Mi
                  'Ma
                ) ;_  vla-getBoundingBox

                (mapcar
                  (function set)
                  '(Mi Ma)
                  (mapcar
                    (function
                      vlax-safearray->list
                    ) ;_  function
                    (list Mi Ma)
                  ) ;_  mapcar
                ) ;_  mapcar

                (setq ss
                       (ssget "_C"
                              (list (car Mi) (cadr Ma) 0.)
                              (list (car Ma) (cadr Mi) 0.)
                       ) ;_  ssget
                ) ;_  setq

                (if
                  (and
                    (setq iLst
                           (apply
                             (function
                               append
                             ) ;_  function
                             (vl-remove 'nil
                                        (mapcar
                                          (function
                                            (lambda (x)
                                              (vlax-list->3D-point
                                                (vlax-invoke
                                                  obj
                                                  'IntersectWith
                                                  x
                                                  acExtendNone
                                                ) ;_  vlax-invoke
                                              ) ;_  vlax-list->3D-point
                                            ) ;_  lambda
                                          ) ;_  function
                                          (ss->list
                                            (ssdel ent ss)
                                          ) ;_  ss->list
                                        ) ;_  mapcar
                             ) ;_  vl-remove
                           ) ;_  apply
                    ) ;_  setq
                    (< 1 (length iLst))
                  ) ;_  and

                   (progn

                     (setq uFlag
                            (not
                              (vla-StartUndoMark *doc)
                            ) ;_  not
                     ) ;_  setq

                     (setq iLst (SortByParam
                                  ent
                                  iLst
                                ) ;_  SortFromPt
                     ) ;_  setq

                     (or
                       (equal
                         (vlax-curve-getStartParam ent)
                         (vlax-curve-getParamatPoint
                           ent
                           (car iLst)
                         ) ;_  vlax-curve-getParamatPoint
                         0.001
                       ) ;_  equal
                       (setq iLst
                              (cons
                                (vlax-curve-getStartPoint ent)
                                iLst
                              ) ;_  cons
                       ) ;_  setq
                     ) ;_  or

                     (or
                       (equal
                         (vlax-curve-getEndParam ent)
                         (vlax-curve-getParamatPoint
                           ent
                           (last iLst)
                         ) ;_  vlax-curve-getParamatPoint
                         0.001
                       ) ;_  equal
                       (setq iLst
                              (append iLst
                                      (list
                                        (vlax-curve-getEndPoint ent)
                                      ) ;_  list
                              ) ;_  append
                       ) ;_  setq
                     ) ;_  or

                     (while
                       (cadr iLst)

                        (setq x (car iLst)
                              y (cadr iLst)
                        ) ;_  setq

                        (setq mPt
                               (vlax-curve-getPointatDist
                                 ent
                                 (/
                                   (+
                                     (vlax-curve-getDistatPoint
                                       ent
                                       y
                                     ) ;_  vlax-curve-getDistatPoint
                                     (vlax-curve-getDistAtPoint
                                       ent
                                       x
                                     ) ;_  vlax-curve-getDistAtPoint
                                   ) ;_  -

                                   2.
                                 ) ;_  /
                               ) ;_  vlax-curve-getPointatDist
                        ) ;_  setq

                        (setq dist
                               (abs
                                 (-
                                   (vlax-curve-getDistatPoint
                                     ent
                                     y
                                   ) ;_  vlax-curve-getDistatPoint
                                   (vlax-curve-getDistAtPoint
                                     ent
                                     x
                                   ) ;_  vlax-curve-getDistAtPoint
                                 ) ;_  -
                               ) ;_  abs
                        ) ;_  setq

                        (setq lAng
                               (angle '(0 0 0)
                                      (vlax-curve-getFirstDeriv
                                        ent
                                        (vlax-curve-getParamatPoint
                                          ent
                                          mPt
                                        ) ;_  vlax-curve-getParamatPoint
                                      ) ;_  vlax-curve-getFirstDeriv
                               ) ;_  angle
                        ) ;_  setq

                        (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                               (setq lAng (- lAng pi))
                              )
                              ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                               (setq lAng (+ lAng pi))
                              )
                        ) ;_  cond

                        ;; AJT MOd Begin
                        (setq tObj (vla-AddMText
                                     (if (or (eq acmodelspace
                                                 (vla-get-activespace *doc)
                                             ) ;_ eq
                                             (eq :vlax-true (vla-get-mspace *doc))
                                         ) ;_ or
                                       (vla-get-modelspace *doc)
                                       (vla-get-paperspace *doc)
                                     ) ;_ if
                                     (vlax-3D-point '(0 0 0))
                                     0
                                     (rtos dist)
                                   ) ;_ vla-AddMText
                        ) ;_ setq


                        (vla-put-AttachmentPoint tObj acBottomCenter)

                        (vla-put-InsertionPoint
                          ;; AJT Mod End
                          tObj
                          (vlax-3D-point
                            (polar mPt
                                   (+ lAng (/ pi 2.))
                                   (getvar 'TEXTSIZE)
                            ) ;_  polar
                          ) ;_  vlax-3D-point
                        ) ;_  vla-put-TextAlignmentPoint

                        (vla-put-rotation tObj lAng)

                        (setq iLst (cdr iLst))
                     ) ;_  while

                     (setq uFlag
                            (vla-EndUndomark *doc)
                     ) ;_  setq
                   ) ;_  progn

                   (princ "\n** Object Has less than Two Intersections **")

                ) ;_  if
              ) ;_  progn

              (princ "\n** Invalid Object Selected **")
            ) ;_  if
           )
     ) ;_  cond
   ) ;_  progn
 ) ;_  while

 (princ)
) ;_ defun

Well, spurred on from Kerry's comments I thoughts I'd see how it would look - but I don't like it to be honest, so I'll probably go back to my old style.

I don't like it when it's broken up that much. I set my margins to 100.

Lee, if you use MText, you can avoid the worry of dealing with annotative text. If you did want to use DText, you could just check to see if the style is annotative then use this instead...

 

(* (/ 1 (getvar 'cannoscalevalue)) (getvar 'textsize))

Food for thought.

 

With MText...

 

 

Thanks Alan, I'm always at a loss as to what TextSize to use...

I've seen this also used:

(getvar 'DIMTXT)

Which may be better in this situation.

Lee

everything works, both codes. PERFECT. Absolutely perfect. Now i have to test it. Thanks Lee and alanjt...again

You're welcome Pontifex I had fun with this one