looking for a routine to place text at the angle of the entity

[Abrasive]

What I would like to do is click on the entity (could be a polyline or a line I use both) and place text at the angle of the entity.

I don't need a prompt for the text as I'm going to hard code the value and make a button for each entity type.

Right now my code places the text but only at an already determined angle.

 

[mhupp]

This won't work with some entity's like circles or polylines because they don't have an angle property.

 

;;----------------------------------------------------------------------;;
;; Match Angle of selection
(defun C:foo (/ s ss ent)
  (if (and (setq s (car (entsel "\nSelect Entity for reference angle")))
           (setq ss (ssget ":L"))
      )
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (entmod (subst (assoc 50 (entget s))
                     (assoc 50 (entget ent))
                     (entget ent)
              )
      )
    )
  )
  (princ)
)

 

Edited July 12, 2022 by mhupp

[Steven P]

You could use something like this to get polyline points, work out the distances, sort to get the closest 2 and from that work out the angle? 

 

;;https://www.cadtutor.net/forum/topic/73414-select-all-points-on-polyline/
(defun c:getplinepoints ( / )
  (setq plent (entsel "\nPick Polyline"))
  (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
  (princ co-ord)
  co-ord
)

 

[Steven P]

This will get you near with a polyline, however.... it works on the closest points in the polyline, if for example the polyline is 'C' shaped it might select points near the 2 ends but not next to each other if the other 2 points are closer.

 

 

(defun c:closestpoints ( / acount rtnlst pt MyAngle)
  (vl-load-com)
  (defun RtD (r) (* 180.0 (/ r pi)))

  (setq acount 0)
  (setq rtnlst (list))

  (setq plent (entsel "\nPick Polyline")) ;;https://www.cadtutor.net/forum/topic/73414-select-all-points-on-polyline/
  (if plent (setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))

  (setq pt (getpoint "Get Point"))

  (while (< acount (length ptlst))
    (setq rtnlst (append rtnlst (list (list (distance pt (nth acount ptlst)) (nth acount ptlst)))))
    (setq acount (+ acount 1))
  ) ; end while
  (setq rtnlst (vl-sort rtnlst (function (lambda (e1 e2) (< (car e1) (car e2))))) )
  (setq MyAngle (RtD (angle (nth 1 (nth 0 rtnlst)) (nth 1 (nth 1 rtnlst)) )) )
)

 

 

 

EDIT.

Actually change that idea - angle can be upside down or right way up depends which end the text is nearest to - will need to put in a thingy if angle > 180 deg. then flip the text

 

Edited July 12, 2022 by Steven P

[BIGAL]

Select pline segment. And a label all by Alan Thomson attached.

 

; Pline segment with angle and length

(defun c:plseg()
(setq plent (entsel "\nSelect Pline  "))
(setvar "osmode" 0)
(setq
      pick (cadr plent)
      plObj (vlax-ename->vla-object (car plent))
      pick2 (vlax-curve-getclosestpointto plobj pick)
      param (vlax-curve-getparamatpoint plObj pick2)
      segment (fix param)
	  co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(setq pt1 (nth segment co-ord))
(setq pt2 (nth (+ segment 1) co-ord))
(if (= pt2 nil)(setq pt2 (nth 0 co-ord)))
(setq len (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(alert (strcat "angle is "  (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3)))
)

 

label pline segments.lsp