How to make a lisp to move texts vertically until they reach a poluline?

[Anonymous]

Hi there,

I was looking for a solution for automated vertical translation of multiple texts to a polyline.

Here is what I've come up to now but it doesn't work yet:

(Defun c:MoveVertical  (/ li txts e verxl var sa)
      (if
            (and (princ "\nSelect Line for Alignment")
                 (setq li (ssget "_+.:S:E" '((0 . "*LINE"))))
                 (princ "\nSelect Texts to Align")
                 (setq txts (ssget "_:L" '((0 . "TEXT,MTEXT"))))
                 (setq verxl (command "xline" (vla-get-insertionpoint e) a "" 90 ""))
                        (setq var (vla-intersectwith verxl li acExtendBoth)
                              sa (vlax-variant-value var))                
                 (repeat (sslength txts)
                       (vla-move
                             (setq e (vlax-ename->vla-object (ssname txts 0)))
                        (vla-get-insertionpoint e)
                        sa
                        )
                       (ssdel (ssname txts 0) txts)
                       )
                 )
      (princ)
      )

I would appreciate any help from any of you!

[ВeekeeCZ · Accepted solution]

Like this? 

(defun c:MoveVertical ( / LM:intersections li ss i ent pnx lnx pnt)
  
  ;; 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))

  ; ---------------------------------------------------------------------------  
  
  (if (and (princ "\nSelect Line for Alignment")
           (setq li (ssget "_+.:S:E" '((0 . "*LINE"))))
           (princ "\nSelect Texts to Align")
           (setq ss (ssget "_:L" '((0 . "*TEXT"))))
           )
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            pnx (cdr (assoc 10 (entget ent))))
      (setq lnx (entmakex (list (cons 0 "XLINE")
                                (cons 100 "AcDbEntity")
                                (cons 100 "AcDbXline")
                                (cons 10 pnx)
                                (cons 11 (polar '(0 0 0) (/ pi 2) 1)))))
      (setq pnt (car (LM:intersections (vlax-ename->vla-object lnx) (vlax-ename->vla-object (ssname li 0)) acExtendBoth)))
      (vla-move (vlax-ename->vla-object ent)
                (vlax-3d-point pnx)
                (vlax-3d-point pnt))
      (entdel lnx)))
  (princ)
  )

BTW The @pbejse's code is quite advanced, better start with something simpler. Just you to know, (command "xline") returns always nil, see the help! If you want to save the xline ename, you need to use (entlast): (command "xline" ...) (setq ent (entlast))

Another thing is - Lee  Mac has very nice library, a lot of useful common things you can find there, as I did: HERE

[Kent1Cooper]

---

@Anonymous wrote:

.... 

(Defun c:MoveVertical  (/ li txts e verxl var sa)
      (if
            (and (princ "\nSelect Line for Alignment")
                 (setq li (ssget "_+.:S:E" '((0 . "*LINE"))))
                 (princ "\nSelect Texts to Align")
                 (setq txts (ssget "_:L" '((0 . "TEXT,MTEXT"))))
                 (setq verxl (command "xline" (vla-get-insertionpoint e) a "" 90 ""))

; can't use (command) as argument to (setq) -- draw it first then (setq verxl (entlast)),

; haven't set e yet,   a ""   should be "a"
                        (setq var (vla-intersectwith verxl li acExtendBoth); needs VLA objects, and

;  li  is a selection set, not an entity that can be converted into a VLA object
                              sa (vlax-variant-value var))
                 (repeat (sslength txts); need to put Xline & intersectwith inside (repeat)
                       (vla-move
                             (setq e (vlax-ename->vla-object (ssname txts 0)))
                        (vla-get-insertionpoint e)
                        sa
                        )
                       (ssdel (ssname txts 0) txts)
                       )
                 )
      (princ)
      )

…. just some things I noticed in a quick perusal

---

[Anonymous]

Thank you very much for the solution! It works perfectly. I'll probably have to dig deeper into vlisps to understand everything but I'll do my best.

[Anonymous]

Thank you too for the explanations! They will come in handy.