Text alignment-Lisp modification

[AirBall]

Hello,

 

I was wondering if someone could help out editing Lee-macs PipeAcrossStat lisp so that the text aligns to the last segment of crossed polyline  (shown in attached cad example). Now it  has rotation of 90 degree at intersection point.

 

 

Example.dwg PipeAcrossStat.lsp

[BIGAL]

For it to work as you want need to pick the crossing objects one at a time, this way you get the end you want to put the label at. It depends on the direction of the crossing line so can not just "GET" the lines, in saying that, you can use the fence option to pick multiples in one go. Again that will imply which end to put label on. The end choice is done in the code.

 

Try this

(defun c:Findinters ( / obj obj2 pt pt2 len d1 d2 start end tmp ang)

(defun _format ( n / nr ns i h)
  (setq head 
	(cond
	  ((setq h (nth (1- (setq i (strlen (setq nr (itoa (fix n))))))
		     	'("00" "0" "")))(strcat "0+" h (rtos n 2 2 )))
	  ((strcat (substr nr 1 (- i 3)) "+"
		   (substr (rtos n 2 2 ) (- i 3)))
	   )
	  )
	)
)
  
(defun rtd (a)
(/ (* a 180.0) pi)
)

;; Make Readable  -  Lee Mac
  ;; Returns a given angle corrected for text readability
(defun lm:makereadable (a)
    ((lambda (a)
       (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
	 (+ a pi)
	 a
       )
     )
      (rem (+ a pi pi) (+ pi pi))
    )
)

(setq obj (vlax-ename->vla-object (car (entsel "\nPick inter object "))))
(while (setq ent (entsel "\nPIck crossing object near end Enter to exit "))
  (setq pt (cadr ent))
  (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
  (setq obj2 (vlax-ename->vla-object (car ent)))
  (setq start (vlax-curve-getstartPoint obj2))
  (setq end (vlax-curve-getendPoint obj2))
  (setq d1 (distance pt start))
  (setq d2 (distance pt end))
  (if (> d1 d2)
  (setq tmp start
    start end
    end tmp
  )
)

(setq pt2 (vlax-invoke obj2 'IntersectWith obj acExtendNone))
(setq len (vlax-curve-getDistAtPoint obj  pt2))

(if (> d1 d2)
  (setq ang (angle (nth (- (length co-ord) 2) co-ord) (last co-ord)))
  (setq ang (angle (car co-ord) (cadr co-ord)))
)
(setq ang (lm:makereadable ang))

(command "text" start 2.5 (rtd ang) (_format len))

)
 (princ)
)

 

Edited October 8 by BIGAL