Lisp for adjusting text overlaps on polylines (Please see attachment)

[Anonymous]

Dear All,

I thanks a lot to the experts, who helped me a lot for my queries.

Recently I tired up with adjusting text overlaps on polylines. Pleasea see attached drawing and snapshot.

Is there any lisp code ? or can you please help me out from this work?

Thanks a lot in Advance.

T.Brahmanandam

[CADaSchtroumpf]

Just a test that works with your example, but that will certainly be insufficient. It can be a start.

(defun c:test ( / js dxf_cod lremov js_mult js_pl pt nw_pt ref_dist op n dxf_ent param deriv alpha)
  (princ "\nSelect model text.")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "TEXT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a Text!")
  )
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 40 1 7))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (setq js_mult (ssget "_X" dxf_cod))
  (princ "\nSelect polyline.")
  (while
    (null
      (setq js_pl
        (ssget "_+.:E:S"
          (list
            '(0 . "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a polyline!")
  )
  (setq pt (vlax-curve-GetClosestPointTo (ssname js_pl 0) (cdr (assoc 10 (entget (ssname js 0)))) nil))
  (initget 1)
  (setq nw_pt (getpoint (trans pt 0 1) "\nNew relative position from polyline?: "))
  (setq ref_dist (distance (trans pt 0 1) nw_pt))
  (initget 1 "Up Down")
  (if (eq (getkword "\nText [Up/Down]?: ") "Up") (setq op '+) (setq op '-))
  (repeat (setq n (sslength js_mult))
    (setq
      dxf_ent (entget (ssname js_mult (setq n (1- n))))
      pt (vlax-curve-GetClosestPointTo (ssname js_pl 0) (cdr (assoc 10 dxf_ent)) nil)
      param (vlax-curve-getparamatpoint (ssname js_pl 0) pt)
      deriv (vlax-curve-getfirstderiv (ssname js_pl 0) param)
      alpha (atan (cadr deriv) (car deriv))
    )
    (if
      (and
        (< (distance pt (cdr (assoc 10 dxf_ent))) (+ (cdr (assoc 40 dxf_ent)) ref_dist))
        (not (equal pt (vlax-curve-getstartpoint (ssname js_pl 0)) 1E-08))
        (not (equal pt (vlax-curve-getendpoint (ssname js_pl 0)) 1E-08))
      )
      (entmod
        (setq
          dxf_ent (subst (cons 10 (polar pt ((eval op) alpha (* 0.5 pi)) ref_dist)) (assoc 10 dxf_ent) dxf_ent)
          dxf_ent (subst (cons 11 (polar pt ((eval op) alpha (* 0.5 pi)) ref_dist)) (assoc 11 dxf_ent) dxf_ent)
          dxf_ent (subst (cons 50 alpha) (assoc 50 dxf_ent) dxf_ent)
        )
      )
    )
  )
  (prin1)
)

[Anonymous]

Dear Sir,

Thanks a lot for responding, the code is working fine. Sir, But is it possible to select multiple texts with multiple polylines?

[CADaSchtroumpf · Accepted solution]

Perhaps?

(defun c:test ( / js dxf_cod lremov js_mult js_pl pt nw_pt ref_dist op nb n dxf_ent param deriv alpha)
  (princ "\nSelect model text.")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "TEXT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a Text!")
  )
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 40 1 7))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (setq js_mult (ssget "_X" dxf_cod))
  (princ "\nSelect a reference polyline.")
  (while
    (null
      (setq js_pl
        (ssget "_+.:E:S"
          (list
            '(0 . "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a polyline!")
  )
  (setq pt (vlax-curve-GetClosestPointTo (ssname js_pl 0) (cdr (assoc 10 (entget (ssname js 0)))) nil))
  (initget 1)
  (setq nw_pt (getpoint (trans pt 0 1) "\nNew relative position from polyline?: "))
  (setq ref_dist (distance (trans pt 0 1) nw_pt))
  (initget 1 "Up Down")
  (if (eq (getkword "\nText [Up/Down]?: ") "Up") (setq op '+) (setq op '-))
  (princ "\nSelect polylines to apply.")
  (setq js_pl (ssget (list '(0 . "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")))))
  (cond
    (js_pl
      (repeat (setq nb (sslength js_pl))
        (setq pt (vlax-curve-GetClosestPointTo (ssname js_pl (setq nb (1- nb))) (cdr (assoc 10 (entget (ssname js 0)))) nil))
        (repeat (setq n (sslength js_mult))
          (setq
            dxf_ent (entget (ssname js_mult (setq n (1- n))))
            pt (vlax-curve-GetClosestPointTo (ssname js_pl nb) (cdr (assoc 10 dxf_ent)) nil)
            param (vlax-curve-getparamatpoint (ssname js_pl nb) pt)
            deriv (vlax-curve-getfirstderiv (ssname js_pl nb) param)
            alpha (atan (cadr deriv) (car deriv))
          )
          (if
            (and
              (< (distance pt (cdr (assoc 10 dxf_ent))) (+ (cdr (assoc 40 dxf_ent)) ref_dist))
              (not (equal pt (vlax-curve-getstartpoint (ssname js_pl nb)) 1E-08))
              (not (equal pt (vlax-curve-getendpoint (ssname js_pl nb)) 1E-08))
            )
            (entmod
              (setq
                dxf_ent (subst (cons 10 (polar pt ((eval op) alpha (* 0.5 pi)) ref_dist)) (assoc 10 dxf_ent) dxf_ent)
                dxf_ent (subst (cons 11 (polar pt ((eval op) alpha (* 0.5 pi)) ref_dist)) (assoc 11 dxf_ent) dxf_ent)
                dxf_ent (subst (cons 50 alpha) (assoc 50 dxf_ent) dxf_ent)
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)

[Anonymous]

Thanks a lot Sir.