Determine if the selected text is outside the selected arc or at the inner side

[Engineer_Yasser]

2 minutes ago, Steven P said:

 

 

Yes, that's what it is meant to do - where the text is of to the sides the extension of the arc follows the curve of its circle rather than a  straight line extension passing the 2 end points of the arc. In which case the simpler code will be using trigonometry from hosneyalaa rather then geometry from my example.

 

(to modify mine I'd need 2 stages, first to determine the inside-outside from the straight line and then for the special case of the 'bump' created by the arc)

 

I assume this red line is what you want? 

 

Yes , i want the result for text "ABC" to be "inside"

[exceed]

 

 

(vl-load-com)
(defun c:ARCTEST ( / ss ssl index tlist ent obj elist 
                  arclist arcrad arccenter arcalongcenter 
                  ll ur lll url midpt unitvect1 xline1
                  xlineobj unitvect2 ray1 tlen resultss
                  1text 1textcen cen2cen ray2 interpt) 
  (setq ss (ssget '((0 . "ARC,TEXT"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq tlist '())
  (repeat ssl 
    (setq ent (ssname ss index))
    (setq obj (vlax-ename->vla-object ent))
    (setq elist (entget ent))
    (cond 
      ((eq (cdr (assoc 0 elist)) "ARC")
       (setq arclist (LM:ArcEndpoints ent))
       (setq arcrad (cdr (assoc 40 elist)))
       (setq arccenter (cdr (assoc 10 elist)))
       (setq arcalongcenter (vlax-curve-getPointAtDist obj 
                                                       (/ 
                                                         (vlax-curve-getDistAtParam obj 
                                                                                    (vlax-curve-getEndParam 
                                                                                                            obj
                                                                                    )
                                                         )
                                                         2
                                                       )
                            )
       )
      )
      ((eq (cdr (assoc 0 elist)) "TEXT")
       (vla-getboundingbox obj 'll 'ur)
       (setq lll (vlax-safearray->list ll))
       (setq url (vlax-safearray->list ur))
       (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5)))
       (setq tlist (cons (list ent midpt) tlist))
      )
    )
    (setq index (+ index 1))
  )
  (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist))))
  (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") 
                             (cons 10 (cadr arclist)) (cons 11 unitvect1)
                       )
             )
  )
  (setq xlineobj (vlax-ename->vla-object xline1))
  (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter)))
  (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                             (cons 10 arcalongcenter) (cons 11 unitvect2)
                       )
             )
  )
  (setq tlen (length tlist))
  (setq index 0)
  (setq resultss (ssadd))
  (repeat tlen
    (setq 1text (nth index tlist))
    (setq 1textcen (cadr 1text))
    (setq cen2cen (distance 1textcen arccenter))
    (if (<= cen2cen arcrad)
      (progn
        (ssadd (car 1text) resultss)
      )
      (progn
        (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                                 (cons 10 1textcen) (cons 11 unitvect2)
                           )
                 )
        )
        (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone))
        (if (= interpt nil)
          (progn
            (ssadd (car 1text) resultss)
          )
          (progn)
        )
        (entdel ray2)
      )
    )
    (setq index (+ index 1))
  )
  (sssetfirst nil resultss)
  (entdel xline1)
  (entdel ray1)
  (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Arc Endpoints  -  Lee Mac
;; Returns the endpoints of an Arc expressed in WCS
(defun LM:ArcEndpoints (ent / cen nrm rad) 
  (setq ent (entget ent)
        nrm (cdr (assoc 210 ent))
        cen (cdr (assoc 010 ent))
        rad (cdr (assoc 040 ent))
  )
  (mapcar 
    (function 
      (lambda (ang) 
        (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) 
               nrm
               0
        )
      )
    )
    (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
  )
)

 

 

how does it works, step by step gif.

(vl-load-com)
(defun c:ARCTEST ( / ss ssl index tlist ent obj elist 
                  arclist arcrad arccenter arcalongcenter 
                  ll ur lll url midpt unitvect1 xline1
                  xlineobj unitvect2 ray1 tlen resultss
                  1text 1textcen cen2cen ray2 interpt circleent) 
  (setq ss (ssget '((0 . "ARC,TEXT"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq tlist '())
  (repeat ssl 
    (setq ent (ssname ss index))
    (setq obj (vlax-ename->vla-object ent))
    (setq elist (entget ent))
    (cond 
      ((eq (cdr (assoc 0 elist)) "ARC")
       (setq arclist (LM:ArcEndpoints ent))
       (setq arcrad (cdr (assoc 40 elist)))
       (setq arccenter (cdr (assoc 10 elist)))
       (setq arcalongcenter (vlax-curve-getPointAtDist obj 
                                                       (/ 
                                                         (vlax-curve-getDistAtParam obj 
                                                                                    (vlax-curve-getEndParam 
                                                                                                            obj
                                                                                    )
                                                         )
                                                         2
                                                       )
                            )
       )
      )
      ((eq (cdr (assoc 0 elist)) "TEXT")
       (vla-getboundingbox obj 'll 'ur)
       (setq lll (vlax-safearray->list ll))
       (setq url (vlax-safearray->list ur))
       (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5)))
       (setq tlist (cons (list ent midpt) tlist))
      )
    )
    (setq index (+ index 1))
  )
  (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist))))
  (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") 
                             (cons 10 (cadr arclist)) (cons 11 unitvect1)
                       )
             )
  )
  (setq xlineobj (vlax-ename->vla-object xline1))
  (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter)))
  (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                             (cons 10 arcalongcenter) (cons 11 unitvect2)
                       )
             )
  )
  (setq circleent (entmakex (list (cons 0 "CIRCLE") (cons 10 arccenter) (cons 40 arcrad))))
  (setq tlen (length tlist))
  (setq index 0)
  (setq resultss (ssadd))
  (repeat tlen
    (setq 1text (nth index tlist))
    (setq 1textcen (cadr 1text))
    (setq cen2cen (distance 1textcen arccenter))
    (if (<= cen2cen arcrad)
      (progn
        (ssadd (car 1text) resultss)
        (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Circle)")
        (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 2)
      )
      (progn
        (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                                 (cons 10 1textcen) (cons 11 unitvect2)
                           )
                 )
        )
        (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone))
        (if (= interpt nil)
          (progn
            (ssadd (car 1text) resultss)
            (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Ray)")
            (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 3)
          )
          (progn)
        )
        (setq answer (getstring))
        (entdel ray2)
      )
    )
   
    (setq index (+ index 1))
  )
  (sssetfirst nil resultss)
  (entdel xline1)
  (entdel circleent)
  (entdel ray1)
  (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Arc Endpoints  -  Lee Mac
;; Returns the endpoints of an Arc expressed in WCS
(defun LM:ArcEndpoints (ent / cen nrm rad) 
  (setq ent (entget ent)
        nrm (cdr (assoc 210 ent))
        cen (cdr (assoc 010 ent))
        rad (cdr (assoc 040 ent))
  )
  (mapcar 
    (function 
      (lambda (ang) 
        (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) 
               nrm
               0
        )
      )
    )
    (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
  )
)

 

Edited October 25, 2023 by exceed

[Engineer_Yasser]

6 hours ago, exceed said:

 

 

(defun c:ARCTEST ( / ss ssl index tlist ent obj elist 
                  arclist arcrad arccenter arcalongcenter 
                  ll ur lll url midpt unitvect1 xline1
                  xlineobj unitvect2 ray1 tlen resultss
                  1text 1textcen cen2cen ray2 interpt) 
  (setq ss (ssget '((0 . "ARC,TEXT"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq tlist '())
  (repeat ssl 
    (setq ent (ssname ss index))
    (setq obj (vlax-ename->vla-object ent))
    (setq elist (entget ent))
    (cond 
      ((eq (cdr (assoc 0 elist)) "ARC")
       (setq arclist (LM:ArcEndpoints ent))
       (setq arcrad (cdr (assoc 40 elist)))
       (setq arccenter (cdr (assoc 10 elist)))
       (setq arcalongcenter (vlax-curve-getPointAtDist obj 
                                                       (/ 
                                                         (vlax-curve-getDistAtParam obj 
                                                                                    (vlax-curve-getEndParam 
                                                                                                            obj
                                                                                    )
                                                         )
                                                         2
                                                       )
                            )
       )
      )
      ((eq (cdr (assoc 0 elist)) "TEXT")
       (vla-getboundingbox obj 'll 'ur)
       (setq lll (vlax-safearray->list ll))
       (setq url (vlax-safearray->list ur))
       (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5)))
       (setq tlist (cons (list ent midpt) tlist))
      )
    )
    (setq index (+ index 1))
  )
  (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist))))
  (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") 
                             (cons 10 (cadr arclist)) (cons 11 unitvect1)
                       )
             )
  )
  (setq xlineobj (vlax-ename->vla-object xline1))
  (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter)))
  (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                             (cons 10 arcalongcenter) (cons 11 unitvect2)
                       )
             )
  )
  (setq tlen (length tlist))
  (setq index 0)
  (setq resultss (ssadd))
  (repeat tlen
    (setq 1text (nth index tlist))
    (setq 1textcen (cadr 1text))
    (setq cen2cen (distance 1textcen arccenter))
    (if (<= cen2cen arcrad)
      (progn
        (ssadd (car 1text) resultss)
      )
      (progn
        (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                                 (cons 10 1textcen) (cons 11 unitvect2)
                           )
                 )
        )
        (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone))
        (if (= interpt nil)
          (progn
            (ssadd (car 1text) resultss)
          )
          (progn)
        )
        (entdel ray2)
      )
    )
    (setq index (+ index 1))
  )
  (sssetfirst nil resultss)
  (entdel xline1)
  (entdel ray1)
  (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Arc Endpoints  -  Lee Mac
;; Returns the endpoints of an Arc expressed in WCS
(defun LM:ArcEndpoints (ent / cen nrm rad) 
  (setq ent (entget ent)
        nrm (cdr (assoc 210 ent))
        cen (cdr (assoc 010 ent))
        rad (cdr (assoc 040 ent))
  )
  (mapcar 
    (function 
      (lambda (ang) 
        (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) 
               nrm
               0
        )
      )
    )
    (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
  )
)

 

 

how does it works, step by step gif.

(defun c:ARCTEST ( / ss ssl index tlist ent obj elist 
                  arclist arcrad arccenter arcalongcenter 
                  ll ur lll url midpt unitvect1 xline1
                  xlineobj unitvect2 ray1 tlen resultss
                  1text 1textcen cen2cen ray2 interpt circleent) 
  (setq ss (ssget '((0 . "ARC,TEXT"))))
  (setq ssl (sslength ss))
  (setq index 0)
  (setq tlist '())
  (repeat ssl 
    (setq ent (ssname ss index))
    (setq obj (vlax-ename->vla-object ent))
    (setq elist (entget ent))
    (cond 
      ((eq (cdr (assoc 0 elist)) "ARC")
       (setq arclist (LM:ArcEndpoints ent))
       (setq arcrad (cdr (assoc 40 elist)))
       (setq arccenter (cdr (assoc 10 elist)))
       (setq arcalongcenter (vlax-curve-getPointAtDist obj 
                                                       (/ 
                                                         (vlax-curve-getDistAtParam obj 
                                                                                    (vlax-curve-getEndParam 
                                                                                                            obj
                                                                                    )
                                                         )
                                                         2
                                                       )
                            )
       )
      )
      ((eq (cdr (assoc 0 elist)) "TEXT")
       (vla-getboundingbox obj 'll 'ur)
       (setq lll (vlax-safearray->list ll))
       (setq url (vlax-safearray->list ur))
       (setq midpt (mapcar '* (mapcar '+ lll url) '(0.5 0.5 0.5)))
       (setq tlist (cons (list ent midpt) tlist))
      )
    )
    (setq index (+ index 1))
  )
  (setq unitvect1 (mapcar '(lambda (x) (/ x (distance (car arclist) (cadr arclist)))) (mapcar '- (cadr arclist) (car arclist))))
  (setq xline1 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") 
                             (cons 10 (cadr arclist)) (cons 11 unitvect1)
                       )
             )
  )
  (setq xlineobj (vlax-ename->vla-object xline1))
  (setq unitvect2 (mapcar '(lambda (x) (/ x (distance arcalongcenter arccenter))) (mapcar '- arccenter arcalongcenter)))
  (setq ray1 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                             (cons 10 arcalongcenter) (cons 11 unitvect2)
                       )
             )
  )
  (setq circleent (entmakex (list (cons 0 "CIRCLE") (cons 10 arccenter) (cons 40 arcrad))))
  (setq tlen (length tlist))
  (setq index 0)
  (setq resultss (ssadd))
  (repeat tlen
    (setq 1text (nth index tlist))
    (setq 1textcen (cadr 1text))
    (setq cen2cen (distance 1textcen arccenter))
    (if (<= cen2cen arcrad)
      (progn
        (ssadd (car 1text) resultss)
        (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Circle)")
        (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 2)
      )
      (progn
        (setq ray2 (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") 
                                 (cons 10 1textcen) (cons 11 unitvect2)
                           )
                 )
        )
        (setq interpt (LM:intersections xlineobj (vlax-ename->vla-object ray2) acextendnone))
        (if (= interpt nil)
          (progn
            (ssadd (car 1text) resultss)
            (vlax-put-property (vlax-ename->vla-object (car 1text)) 'textstring "Gotcha (Ray)")
            (vlax-put-property (vlax-ename->vla-object (car 1text)) 'color 3)
          )
          (progn)
        )
        (setq answer (getstring))
        (entdel ray2)
      )
    )
   
    (setq index (+ index 1))
  )
  (sssetfirst nil resultss)
  (entdel xline1)
  (entdel circleent)
  (entdel ray1)
  (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Arc Endpoints  -  Lee Mac
;; Returns the endpoints of an Arc expressed in WCS
(defun LM:ArcEndpoints (ent / cen nrm rad) 
  (setq ent (entget ent)
        nrm (cdr (assoc 210 ent))
        cen (cdr (assoc 010 ent))
        rad (cdr (assoc 040 ent))
  )
  (mapcar 
    (function 
      (lambda (ang) 
        (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) 
               nrm
               0
        )
      )
    )
    (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
  )
)

 

 

 

  Wooow ... very very nice work 

 

 

[Steven P]

Very nice!