Trying to combine two working lisps, and possibly allow it to work for all selected texts

Trying to combine two working lisps, and possibly allow it to work for all selected texts

tpatelEGTP3
Explorer Explorer
727 Views
7 Replies
Message 1 of 8

Trying to combine two working lisps, and possibly allow it to work for all selected texts

tpatelEGTP3
Explorer
Explorer

Hi guys, I have a massive drawing that I'm working on. It currently looks like this.

tpatelEGTP3_0-1723232003180.png

I've been using two different lisps to make it looks like this.

tpatelEGTP3_1-1723232103504.png

 

(defun c:MoveTextToVSpotBlock ( / ss blocks txt blk blkpnt txtpnt closestblkpt mindist dist)
  (setq ss (ssget '((0 . "TEXT")))) ; Select all text objects
  (if ss
    (progn
      (setq blocks (ssget "X" '((0 . "INSERT") (8 . "V-S-SPOT")))) ; Select all blocks on layer "V-S-SPOT"
      (if blocks
        (progn
          (while (> (sslength ss) 0) ; Loop until all selected texts are processed
            (setq txt (ssname ss 0)) ; Get the first text entity
            (setq txtpnt (cdr (assoc 10 (entget txt)))) ; Get the insertion point of the text
            (setq mindist nil) ; Initialize the minimum distance
            (setq closestblkpt nil) ; Initialize the closest block point
            (setq closestblk nil) ; Initialize the closest block entity

            ; Iterate over all blocks to find the closest one
            (repeat (sslength blocks)
              (setq blk (ssname blocks 0)) ; Get the first block entity
              (setq blkpnt (cdr (assoc 10 (entget blk)))) ; Get the insertion point of the block
              (setq dist (distance txtpnt blkpnt)) ; Calculate the distance between the text and the block

              ; If this block is the closest so far, store its point
              (if (or (not mindist) (< dist mindist))
                (progn
                  (setq mindist dist)
                  (setq closestblkpt blkpnt)
                  (setq closestblk blk) ; Store the closest block entity
                )
              )
              (setq blocks (ssdel blk blocks)) ; Remove the checked block from the selection set
            )

            ; Move the text to the closest block point
            (if closestblkpt
              (progn
                (command "MOVE" txt "" txtpnt closestblkpt)
                (setq blocks (ssdel closestblk blocks)) ; Remove the used block from the selection set
              )
            )

            (setq ss (ssdel txt ss)) ; Remove the moved text from the selection set
          )
        )
        (princ "\nNo blocks found on layer V-S-SPOT.")
      )
    )
  )
  (princ)
)
;;---------------------------=={ Align Text }==-------------------------;;
;;                                                                      ;;
;;  This program enables the user to reposition a selection of          ;;
;;  single-line text objects to be aligned by their text alignment      ;;
;;  points in a direction perpendicular to the rotation of the text,    ;;
;;  optionally equispaced by a factor of the text height.               ;;
;;                                                                      ;;
;;  The program assumes all text objects in the selection have the      ;;
;;  same rotation and will align each text object using the coordinates ;;
;;  of the text alignment point.                                        ;;
;;                                                                      ;;
;;  The program will perform successfully with text constructed in      ;;
;;  any UCS plane.                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2016-01-16                                      ;;
;;----------------------------------------------------------------------;;

(defun c:at ( / *error* ang bp1 bp2 enx inc ins lst ocs sel spf vc1 vc2 )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if (setq sel (ssget "_:L" '((0 . "TEXT"))))
        (progn
            (initget 6)
            (setq spf (cond ((getdist "\nSpecify line spacing factor <use existing>: ")))
                  inc (sslength sel)
                  enx (entget (ssname sel (1- inc)))
                  ang (cdr (assoc 50 enx))
                  ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  vc1 (trans (list    (cos ang)  (sin ang)) ocs 0)
                  vc2 (trans (list (- (sin ang)) (cos ang)) ocs 0)
                  spf (if spf (* (cdr (assoc 40 enx)) spf))
            )
            (repeat inc
                (setq enx (entget (ssname sel (setq inc (1- inc))))
                      lst (cons (list  (trans (aligntext:gettextinsertion enx) (cdr (assoc -1 enx)) 0) enx) lst)
                      ins (cons (caddr (trans (caar lst) 0 vc2)) ins)
                )
            )
            (setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>))
                  bp1 (caddr (trans (caar lst) 0 vc1))
                  bp2 (caddr (trans (caar lst) 0 vc2))
            )
            (LM:startundo (LM:acdoc))
            (foreach  itm (cdr lst)
                (if spf
                    (setq ins (trans (car itm) 0 vc2)
                          ins (trans (list (car ins) (cadr ins) (- bp2 spf)) vc2 vc1)
                          bp2 (- bp2 spf)
                    )
                    (setq ins (trans (car itm) 0 vc1))
                )
                (aligntext:puttextinsertion
                    (trans (list (car ins) (cadr ins) bp1) vc1 (cdr (assoc -1 (cadr itm))))
                    (cadr itm)
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

(defun aligntext:getdxfkey ( enx )
    (if
        (and
            (zerop (cdr (assoc 72 enx)))
            (zerop (cdr (assoc 73 enx)))
        )
        10 11
    )
)

(defun aligntext:gettextinsertion ( enx )
    (cdr (assoc (aligntext:getdxfkey enx) enx))
)

(defun aligntext:puttextinsertion ( ins enx )
    (   (lambda ( key )
            (if (entmod (subst (cons key ins) (assoc key enx) enx))
                (entupd (cdr (assoc -1 enx)))
            )
        )
        (aligntext:getdxfkey enx)
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 


One lisp moves the text to the nearest X point, which is a block, and then the other one adjusts the space in between them. (Shout out to Lee Mac)

For some reason, I can't combine them, or have them work for more than 1 group of text. I was wondering if anyone can guide me in the right direction?

0 Likes
728 Views
7 Replies
Replies (7)
Message 2 of 8

tpatelEGTP3
Explorer
Explorer

Thanks in advance guys, and if someone has a more efficient approach, would be more than welcome.

0 Likes
Message 3 of 8

ec-cad
Collaborator
Collaborator

Here's a method.

;; You can call / run a 2nd Lisp from the first.
;; Lets call the first program you run, Lisp1.lsp
;; and the 2nd program you run, Lisp2.lsp
;; AND, in the first Lisp1.lsp you have a function call "c:MoveTextToVSpotBlock"
;; AND, in the second Lisp2.lsp you have a function call "C:at"

;; You load and run (both) routines by doing a 'load' of the 2nd lisp at the 'end' of
;; the first lisp, AND in the Lisp2.lsp, you need to 'call' it's function

Top down approach
(load "Lisp1.lsp)
(C:MoveTextToVSpotBlock); call 1st function or at Command Prompt..
..........
..........
at the bottom:
)
(princ)
)
;;
; Add to call / run 2nd routine
(load "c:\\MYlisp\\Lisp2.lsp"); where the path is your path
(c:at)

 

0 Likes
Message 4 of 8

ec-cad
Collaborator
Collaborator

Alternative method:

In the 1st program, remove the 'ss' from the defun line.
Like this:
(defun c:MoveTextToVSpotBlock ( / blocks txt blk blkpnt txtpnt closestblkpt mindist dist)
Since ss will contain all the TEXT and will still be in memory
The 'ss' is defined by next line in 1st lisp
(setq ss (ssget '((0 . "TEXT")))) ; Select all text objects

And in the 2nd lisp (you could actually just append the entirety of Lisp2 to Lisp1
in Notepad. Barring that, change Lisp2 like this:

;; (if (setq sel (ssget "_:L" '((0 . "TEXT")))) ;<replace this line with the next (2) lines
(setq sel ss); transfer ss from 1st lisp
(if sel
(progn .....

 

ECCAD

0 Likes
Message 5 of 8

tpatelEGTP3
Explorer
Explorer
I did like you said and it does not work, am I missing something?
0 Likes
Message 6 of 8

ec-cad
Collaborator
Collaborator

I don't know which method you used, or what the issue is.

I'll try to 'glue' together those routines for you.

It would be helpful if you post a small sample drawing, before / after would be good.

 

ECCAD

 

0 Likes
Message 7 of 8

Kent1Cooper
Consultant
Consultant

@tpatelEGTP3 wrote:

.... if someone has a more efficient approach....


A very small and insignificant suggestion, but anyway:

 

The (ssdel) function updates the contents of the existing selection set variable from which something is deleted.  It is not necessary to wrap that in a re-setting of the reduced selection into the same variable name.  This from line 29 of the first routine:

 

(setq blocks (ssdel blk blocks)) ; Remove the checked block from the selection set

 

can be simply this:

 

(ssdel blk blocks) ; Remove the checked block from the selection set

 

and likewise with line 36, and line 40 about Text objects.

Kent Cooper, AIA
0 Likes
Message 8 of 8

Kent1Cooper
Consultant
Consultant

@tpatelEGTP3 wrote:
... it does not work....

That is never enough information.

Kent Cooper, AIA
0 Likes