Lisp to get or put ACAD points at leader or mleader vertex

[jaruugarte]

Hello everyone

I ask for help who can in this case, here is the issue.

I've a plan with 20,216 leaders with their respectives levels, what I need is put a point in the begin of the leader, or as well get the coord of the first vertex of the leader, that's what I have in mind, another form is doing a lisp that create a point at first vertex and then attract the text that contains the level to point. so many ideas i've but you're the pros in the bussines.

I appreciate the help you can give me, also if it serves you put a lisp, which contains a part of code that is used to attract texts to the points, created by the Guru of the Mr. Lee Mac programming 

Regards.

[devitg]

@jaruugarte Please show A  before and after at this few leader 

[devitg · Accepted solution]

@jaruugarte You will have to  split the dwg in  small qty . 

The original have about 10300 text and leader pairs , and it crash ACAD

1000 pairs is good 

Find attached lisp and some dwg samples 

The LEE-MAC defun put the txt in not a equal way , it need a revision to fix it  to . 

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2022 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;
; ----------------------------------------------------------------------
; DISCLAIMER:  Gabriel Calos De Vit Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold Gabriel Calos De Vit harmless from such claims.
; Gabriel Calos De Vit makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
;;************************************************************
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;************************************************************
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;##############################################################################################################################
;;put-point-at-leader-vertex
;;;(setq obj RECT)


;; Text 2 Point  -  Lee Mac 2012
;; Prompts for a selection of Text and Point entities and moves
;; each Text entity to the nearest (2D distance) Point entity in the set.
;;
;; Retains existing Text elevation.
(defun txt2pt ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )

    (defun _textinsertion (elist)
  (if
    (and
      (zerop (cdr (assoc 72 elist)))
      (zerop (cdr (assoc 73 elist)))
    ) ;_  and
     (cdr (assoc 10 elist))
     (cdr (assoc 11 elist))
  ) ;_  if
) ;_  defun _textinsertion


    (if (setq sel (ssget "_x" '((0 . "POINT,TEXT") (8 . "-03 Niveles,0")))); change code 8 as need 
      (progn
        (repeat (setq inc (sslength sel))
          (setq ent (entget (ssname sel (setq inc (1- inc)))))
          (if (eq "POINT" (cdr (assoc 0 ent)))
            (setq lst (cons (cdr (assoc 10 ent)) lst))
            (setq txt (cons (cons (_textinsertion ent) ent) txt))
          ) ;_  if
        ) ;_  repeat
        (foreach
               ent
                  txt
          (setq ins (list (caar ent) (cadar ent)))
          (if (setq
                pnt (vl-some '(lambda (pnt) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst)
              ) ;_  setq
            (setq lst (vl-remove pnt lst))
            (progn
              (setq di1 (distance ins (list (caar lst) (cadar lst)))
                    mpt (car lst)
              ) ;_  setq
              (foreach
                     pnt
                        (cdr lst)
                (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1)
                  (setq di1 di2
                        mpt pnt
                  ) ;_  setq
                ) ;_  if
              ) ;_  foreach
              (setq pnt (list (car mpt) (cadr mpt) (caddar ent))
                    dxf (cdr ent)
                    dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf)
                    dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf)
              ) ;_  setq
              (entmod dxf)
              (setq lst (vl-remove mpt lst))
            ) ;_  progn
          ) ;_  if
        ) ;_  foreach
      ) ;_  progn
    ) ;_  if
    (princ)
)
;;;(vl-load-com) (princ)








;************************************************************************************************************


(defun put-point-at-leader-vertex (/
                                 ACAD-OBJ ADOC LEADER-OBJ-SS LEADER-SS MODEL  
                                   ) ;_  /


  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  
  (setq leader-ss
         (ssget "X"
                '((0 . "LEADER")
                  (8 . "-02 Flecha")
                  (67 . 0)
                  (410 . "Model")
                  (100 . "AcDbLeader")
                  (3 . "Standard")
                 )
         ) ;_  ssget
  ) ;_  setq leader-ss 


  (setq leader-obj-ss (vla-get-ActiveSelectionSet adoc))
 
  (vlax-for
         leader-obj
                   leader-obj-ss
    (vla-addpoint model (VLAX-3D-POINT (vlax-curve-getStartPoint leader-obj)))
  ) ;_  vlax-for leader-obj
  (setvar 'pdmode 1)
    (txt2pt)
) ;_  defun put-point-at-leader-vertex



(defun c:put@vertex ()
  (put-point-at-leader-vertex)
  (princ) 
);end main defun  
;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;