Move location of Mleader text

Move location of Mleader text

Anonymous
Not applicable
591 Views
1 Reply
Message 1 of 2

Move location of Mleader text

Anonymous
Not applicable

I am trying to create a routine to allow user to cycle thru all mleader in drawing and allow user to move text location.

 

Here was what I have -

(defun C:MML ()
  (if (setq SSttm (ssget "X" (list (cons 0 "MULTILEADER"))))
    (progn
      (setq KK 0)
      (while (< KK (sslength SSttm))
        (setq Mobj (vlax-ename->vla-object (ssname SSttm KK)))
        (setq Tlab (vla-get-TextString Mobj))
        (setq EG (entget (ssname SStti KK)))    ;prefer to use vla-
        (setq P1 (cdr (assoc 110 EG)))        ;can't figure out how to get leader arrowhead location point
        (setq P2 (cdr (assoc 10 EG)))        ;can't figure out how to get leader landing   location point
        (redraw (cdr (assoc -1 EG)) 3)
        (command "ZOOM" "C" P2 "")
        (setq P3 (getpoint P1 "Pick NEW Location for Mleader Text ? "))
        (if (and P3 (not (equal P3 P2)))
          (progn
            ;area of code to modify
            (getstring "?")
          )
        )
        (redraw (cdr (assoc -1 EG)) 4)
        (if (and Mobj (not (vlax-object-released-p Mobj))) (vlax-release-object Mobj))
        (setq KK (1+ KK))
      )
    )
  )
  (princ)
)

0 Likes
592 Views
1 Reply
Reply (1)
Message 2 of 2

ВeekeeCZ
Consultant
Consultant

This is part of my code, where I rotate a MULTILEADER.

The thing is, MULTILEADER is using multiple 10 code...

 

            ((eq enType "MULTILEADER")
             (if (eq (cdr (assoc 290 en)) 1)
               (progn
                 (setq alfa2ucs (- alfa2  ;to UCS
                                  (angle '(0 0 0) (getvar "UCSXDIR"))))
                 (if (< alfa2ucs 0) (setq alfa2ucs (+ alfa2ucs (* 2 PI))))
                 (vla-put-TextRotation (vlax-ename->vla-object enName) alfa2ucs)) ;works ML with Mtext only
               (progn 							    ;for ML with block
                 (mapcar '(lambda (x)
                            (if (member (car x) '(10))		
                              (setq lst10 (cons x lst10))))	;multiple '(10.*)
                         en)
                 (setq lst10 (reverse lst10))	      ;2nd '(10.*) = refPt,             '(46.*) blockAngle
                 (command "_.ROTATE" enName "" (trans (cdr (nth 1 lst10)) 0 1) (- alfa2 (cdr (assoc 46 en))))  
                 (setq en (entget enName) ;refresh after rotate
                       y  1
                       m  (length lst10)
	               en (mapcar '(lambda (x)
                                     (if (and (if (member (car x) '(10))
                                                (setq y (1+ y)))
                                              (and (> (1- y) 2)	;3th - (m-1)th '(10.*) replace with old
                                                   (< (1- y) m)))
                                       (nth (- y 2) lst10)
                                       x))
                                  en)
                       lst10 nil)
                 (entmod en))))

 

0 Likes