Topic: Roll Your Own Leader Routine, Need UCS help

[CAB]

I have been working on my own version of the Qleader routine.
It is a version to call from a lisp & this version is a 3 point standard leader. (my standard)
The routine uses the vla-addleader.
See the routine & test call to the routine.

The remaining problem I am trying to solve  is that the Middle of the Top/Bottom Line attachment
is giving me problems. The Leader dxf code 213 is used as a vector to locate the Mtext.
With all the other justifications it is '(213 0.0 0.0 0.0)

So my problem is a UCS WCS one.

This code seems close to working:

Code: [Select]

  (cond
    ((= just "MT") ;  Middle of Top Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht 2.0) 0.0) ent 1)) (assoc 213 elst) elst))
     (vla-put-insertionPoint mtextobj (vlax-3d-point (trans(polar p3 (/ pi 2) (/ txtht 2.0)) 1 0)))
     (vla-put-insertionPoint mtextobj (vla-get-insertionPoint mtextobj))
    )
    ((= just "MB") ;  Middle of Bottom Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht -2.0) 0.0) ent 1)) (assoc 213 elst) elst))
     (vla-put-insertionPoint mtextobj (vlax-3d-point (trans(polar p3 (* pi 1.5) (/ txtht 2.0)) 1 0)))
     (vla-put-insertionPoint mtextobj (vla-get-insertionPoint mtextobj))
    )
  ) 
But this (/ txtht 2.0) needs to be (/ txtht -2.0) some of the time. I suspect there is more to it than that.
My test have been in WCS with a rotation (90 deg about the Z axis).

Any UCS suggestions?

Code: [Select]

;;================================================================
;;   Add a 3 point leader 
;;================================================================

(defun addLeader (p1 p2 p3 txt txtht just / mtextobj doc elst ent ptlist
                   gap ldrobj leaderatt mspace p4 tmparray  xdata)
  ;;  points are UCS
  ;;  just = "T" "M" "B" "MT" "MB" "U"
 
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelSpace doc))

 
  ;;  Note DimGap is negative when the Style calls for the text to be boxed
  ;;  there are occasions when DimScale is zero
  (setq gap (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE")) (getvar "DIMGAP"))))

  (setq p4 (polar p3 (angle p2 p3) gap)) ; Position for Mtext
 
  ;;  add an mtext object to associate with the leader:
  ;;  uses current text style & height, zero width mtext
  (setq mtextobj (vla-addMText mspace (vlax-3d-point (trans p4 1 0)) 0.0 txt))
  (vla-put-height mtextobj txtht)

  ;;  Adjust Mtext Justification for Left/Right Leader
  (if (> (car p3)(car p2))
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopLeft)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleLeft)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomLeft)
        )
      )
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopRight)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleRight)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomRight)
        )
      )
  )
 
  ;;  Need to reposition Mtext as changing the acAttachmentPoint will move it
  (vla-put-insertionPoint mtextobj (vlax-3d-point (trans p4 1 0)))
  (vla-update mtextobj) ; updates the screen, remove after debug
 
 
  ;; build an array of coordinates [UCS to WCS]
  (setq ptlist (apply 'append (mapcar '(lambda(x) (trans x 1 0)) (list p1 p2 p3))))

  ;;  Create the Leader & associate the text
  ;;  text is moved to position TL TR BL BR if needed
  ;;  The array of 3D WCS coordinates specifying the leader.
  (setq tmparray (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1))))
  (vlax-safearray-fill tmparray ptlist)
  ;;  not needed (setq tmp (vlax-make-variant tmparray))
  (setq ldrObj (vla-addLeader mspace tmparray mtextobj acLineWithArrow) )
  (vla-put-verticaltextposition ldrObj acVertCentered)
 
  ;;  adjust leader vector for 'Middle of Top/Bottom Line'
  (setq elst (entget (setq ent (vlax-vla-object->ename ldrObj))))

 
  (cond
    ((= just "MT") ;  Middle of Top Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht 2.0) 0.0) ent 1)) (assoc 213 elst) elst))
     (vla-put-insertionPoint mtextobj (vlax-3d-point (trans(polar p3 (/ pi 2) (/ txtht 2.0)) 1 0)))
     (vla-put-insertionPoint mtextobj (vla-get-insertionPoint mtextobj))
    )
    ((= just "MB") ;  Middle of Bottom Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht -2.0) 0.0) ent 1)) (assoc 213 elst) elst))
     (vla-put-insertionPoint mtextobj (vlax-3d-point (trans(polar p3 (* pi 1.5) (/ txtht 2.0)) 1 0)))
     (vla-put-insertionPoint mtextobj (vla-get-insertionPoint mtextobj))
    )
  )

  ;;==========================================
  ;;  Add Xdata needed to make this a QLeader
  ;;==========================================

  ;;  make it a QLeader
  (setq LeaderAtt (min (vl-position Just '("T" "MT" "M" "MB" "B" "U")) 4))
    (setq xdata (list (list -3
                    (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{")
                          '(1070 . 147) (cons 1040 (vla-get-textgap ldrObj)) ; Dimgap
                          '(1070 . 77) (cons 1070 0) ; Underline Text
                          '(1070 . 41) (cons 1040 (getvar "DIMASZ"))  ; Arrow head Size
                          '(1070 . 40) (cons 1040 (getvar "DIMSCALE"))  ; DIMSCALE
                          '(1002 . "}")))))
  (entmod (append elst xdata))


  ;;  Clean Up
  (vla-update ldrObj) ; updates the screen
  (vlax-release-object ldrObj)
 
  (vla-update mtextobj) ; updates the screen
  (vlax-release-object mtextobj)
  (princ)
)

Code: [Select]

;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;;                T E S T   R O U T I N E                 
;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:test (/ p1 p2 p3 LA usrorm)
  (vl-load-com)
  ;;  Get the 2nd point
  ;;  Draw temporary Leader w/ arrow using grvecs
  (defun GetPoint2 (p0 / gr org pt ang_arrow sz)
    (defun arrow (p0 arw_ang col size / p1 p2 p3)
      (setq size (* size 0.6)
            p2 (polar p0 (+ arw_ang pi) size)
            p1 (polar p2 (+ arw_ang (* pi 0.85)) size)
            p3 (polar p2 (+ arw_ang (* pi 1.15)) size))
      (grvecs (list col p0 p1 p1 p2 p2 p3 p3 p0))
    )
 
    (setq sz (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE"))
                    (getvar "DIMASZ"))))
    (while (= (car (setq gr (grread nil 7))) 5)
      (setq pt        (cadr gr)
            ang_arrow (angle pt p1)
      )
      (redraw)
      (arrow p1 ang_arrow 256 sz)
      (grvecs (list 256 p1 pt))
    )
    pt
  )

  (setq usrorm (getvar "orthomode"))
  (setvar "orthomode" 0)
  ;(or (setq LA "2") ; Debug
  (initget "1 2 3 4 5") ; Leader Attachment -
  (setq LA (cond ((getkword "\nAttach? 1Top 2MidTop 3Middle 4MidBottom 5Bottom:"))
                 ("1")
           )
  )
 ; ) ; debug
  (if (and (setq p1 (getpoint "\nPick start of 3 point leader."))
           ;;(setq p2 (getpoint p1 "\nPick next point of leader."))
           (princ "\nPick next point of leader.")
           (setq p2 (getpoint2 p1))
      )
    (progn
      ;;(grvecs (list 256 p1 p2))
      (setvar "orthomode" 1)
      (if (setq p3 (getpoint p2 "\nPick end of leader."))
        (setq p3 (subst (cadr p2) (cadr p3) p3))
      )
      (redraw)
      (if (and p1 p2 p3)
        (progn
          (addLeader p1 p2 p3
                     "This is a test\\PSecond Line\\PThird Line"
                     (getvar "TEXTSIZE")
                     (nth (atoi LA) '("" "T" "MT" "M" "MB" "B" "U"))
          )
        )
      )
    )
  )
  (setvar "orthomode" usrorm)
  (princ)
)<edit: updated code, wrong version posted>

[CAB]

Oops, just updated the code. I did not post the latest version.

[Krushert]

CAB,

If I may be so bold, why are you wanting to roll your own leader routine?  What don't you like about the core routine?  Or is just to see if you can do it? 

[CAB]

My reasons are:
To avoid using the COMMAND in my lisp. Also in ACAD2000 the qleader miss behaves in rotated UCS.
I would also be able to control the leader style options without setting & restoring the current style options.
Or modifying the leader after the command. You can also catch the user ESCAPE before the leader is created.
I like to have control over the prompts & setting options & lock the user out. This is for specific
lisp routines. I am working on my TextInsert.lsp at this time & need to be able to override the text height.

I know ACAD Leaders have improved but I still want to do it my way in my lisp routines.

Thanks for asking Ted.

[Krushert]

Okay.

I do not question the reasons of Lisp Gods with air of judgment but rather with air of curiosity so that I may learn.

[CAB]

Thanks for the kind words. If there is any attitude in my reply it was not my intention.
Please chalk it up to my long Monday. :doa:

It's just that I want to control the way the user interacts with MyLeader routine.

Here is an earlier attempt at reining in the Leader command.
http://www.theswamp.org/index.php?topic=20353.0
So you see I've been trying to conquer this for some time.

[Joe Burke]

Hi Alan,

I assume the mtext is supposed to be associated with the leader. If so, the problem I'm seeing is caused by the cond statement you mentioned. Moving the mtext after the fact is causing the third point of the leader to change.  Or am I missing something?

BTW, there's a line near the top of the test routine which needs to be commented out.

[whdjr]

CAB,

I used to have the same problem in a routine I used a while back.  I don't remember which routine it was or what it did, but I know it would go haywire if I tried to run it in a non world UCS.  What I did was store the current UCS, change it to WORLD, run routine, then restore the UCS.  It may not be what you want to do but it may be a solution for you.

[CAB]

Hi Alan,

I assume the mtext is supposed to be associated with the leader. If so, the problem I'm seeing is caused by the cond statement you mentioned. Moving the mtext after the fact is causing the third point of the leader to change.  Or am I missing something?

BTW, there's a line near the top of the test routine which needs to be commented out.

Yes Joe, the Mtext is positioned correctly but when you move the mtext the leader repositions to TOP when it should be 'Middle of Top Line'.

You mean the line that prevents the user from selecting the justification type. I commented it out to allow user selection now.

Thanks

[CAB]

Hey Will,
Yes the problem comes when I try to create the Leader & Text. Even in a WCS that is rotated about the Z axis.

You see the Leader uses 3 DXF codes to control this:

Code: [Select]

210    Normal vector    DXF: X value; APP: 3D vector
211    "Horizontal" direction for leader     DXF: X value; APP: 3D vector
213    Offset of last leader vertex from annotation placement point
                     DXF: X value; APP: 3D vectorIt's to the point I need to give it a rest & come back to it.
The fresh look at a problem often yields the answers. 

[Joe Burke]

Alan,

I mean this line in the test routine, which causes load failure.

(defun GetPoint2 (p1 / gr org pt ang_arrow sz)

You forgot to comment it out.

[CAB]

Oh, that's what I get for trying to edit part of the posted code!
Thanks, extra code removed.

[Joe Burke]

Alan,

I'm still not sure whether the mtext is supposed to be associated with the leader or not.

[CAB]

Oh, yes definitely.
Using the vla-addleader makes it so. If you want it disassociated you need to remove the DXF 340 code.
But you already knew that.

[Joe Burke]

Alan,

Thanks for confirmation.

Given that, what I don't understand is how you might move the insertion point of the mtext without changing the third point of the leader. The two are tied together. Moving the mtext will cause the the third leader point to change, which make no sense to me.

[CAB]

Creating a leader Left with a Mtext justified Top Left and the attachment point as 'Middle of Top Line'
The last leader point is offset on the X axis by the GAP & 1/2 the text height on the Y axis
My routine adds the leader & ACAD places the text as if it was Top Left attachment. The routine then
places the text st the correct position & updates the DXF 211 & 213 vectors. This works in WCS but
not in a rotated WCS about the Z axis. If you move the text in the WCS the leader follows correctly,
but in the rotated WCS the leader repositions to TOP Left & not middle of Top Line.

[Joe Burke]

Alan.

All I know at this point is we are not on the same page and I probably don't understand the code.

Sorry...

[GDF]

This is a little off the subject, but I have quit using the leader command, and use my own polyline leader that I place first, followed up with dtext afterwards.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;; Polyline Leader Routine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; UPOINT Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;unknown author
(defun ARCH:UPOINT  (bit kwd msg def bpt / inp)
  (setvar "CMDECHO" 0)
  (if def
    (setq pts (strcat (rtos (car def))
                      ","
                      (rtos (cadr def))
                      (if (and (caddr def) (= 0 (getvar "FLATLAND")))
                        (strcat "," (rtos (caddr def)))
                        ""))
          msg (strcat "\n" msg " <" pts ">: ")
          bit (* 2 (fix (/ bit 2))))
    (setq msg (strcat "\n" msg " ")))
  (initget bit kwd)
  (setq inp (if bpt
              (getpoint msg bpt)
              (getpoint msg)))
  (if inp
    inp
    def))
(defun ARCH:UPOINTX  (bit kwd msg def bpt / inp)
  (setvar "CMDECHO" 0)
  (if def
    (setq pts (strcat (rtos (car def))
                      ","
                      (rtos (cadr def))
                      (if (and (caddr def) (= 0 (getvar "FLATLAND")))
                        (strcat "," (rtos (caddr def)))
                        ""))
          msg (strcat "\n" msg " <" pts ">: ")
          bit (* 2 (fix (/ bit 2))))
    (setq msg (strcat "\n" msg " ")))
  (initget bit kwd)
  (setq inp (if bpt
              (getpoint msg bpt)
              (getpoint msg)))
  (setvar "osmode" 1)
  (if inp
    inp
    def))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LDR-IT  (/ tmp)
  (setvar "CMDECHO" 0)
  (prompt "\n* Enter for default Leader w/ 3 picks *")
  (initget "2 3 4 C X")
  (setq tmp
         (getkword
           "\n* Pick Arrow Poly Leader type:  <2> Picks   <3> Picks   <4> Picks   <X> Xpoly *"))
  (cond ((= tmp "2") (LDR2IT))
        ((or (= tmp "3") (= tmp nil)) (LDR3IT))
        ((= tmp "4") (LDR4IT))
        ((= tmp "X") (LDRXIT)))
  (princ))
;;;
(defun LDR2IT  (/ pt1 pt2 pt3)
  (ARCH:F_S-VAR)
  (setvar "CMDECHO" 0)
  ;;(ARCH:CUSTOM_LAYERS-ANNO)
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (setq pt1 (ARCH:UPOINTX 1 "" "* Pick arrow head start point *" nil nil)
        pt2 (ARCH:UPOINTX 1 "" "* To point *" nil pt1)
        pt3 (polar pt1 (angle pt1 pt2) (* 0.2 (getvar "DIMSCALE"))) ;0.125
        )
  (setvar "osmode" 0)
  (ARCH:CUSTOM_LAYERS-ANNO-LDR)
  (command
    "PLINE"
    pt1
    "W"
    "0"
    (* 0.065 (getvar "DIMSCALE")) ;0.0417
    pt3
    "W"
    "0"
    "0"
    pt2)
  (command "")
  ;;(command "change" "l" "" "p" "c" "1" "")
  (ARCH:F_R-VAR))
;;;
(defun LDR3IT  (/ pt1 pt2 pt3)
  (ARCH:F_S-VAR)
  (setvar "CMDECHO" 0)
  ;;(ARCH:CUSTOM_LAYERS-ANNO)
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (setq pt1 (ARCH:UPOINT 1 "" "* Pick arrow head start point *" nil nil)
        pt2 (ARCH:UPOINT 1 "" "* To point *" nil pt1)
        pt3 (polar pt1 (angle pt1 pt2) (* 0.2 (getvar "DIMSCALE"))) ;0.125
        )
  (setvar "orthomode" 1)
  (ARCH:CUSTOM_LAYERS-ANNO-LDR)
  (command
    "PLINE"
    pt1
    "W"
    "0"
    (* 0.065 (getvar "DIMSCALE")) ;0.0417
    pt3
    "W"
    "0"
    "0"
    pt2)
  ;;(while (setq pt2 (getpoint "\n* To point *" pt2)) (command pt2))   
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (command "")
  ;;(command "change" "l" "" "p" "c" "1" "")
  (ARCH:F_R-VAR))
;;;
(defun LDR4IT  (/ pt1 pt2 pt3)
  (ARCH:F_S-VAR)
  (setvar "CMDECHO" 0)
  ;;(ARCH:CUSTOM_LAYERS-ANNO)
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (setq pt1 (ARCH:UPOINT 1 "" "* Pick arrow head start point *" nil nil)
        pt2 (ARCH:UPOINT 1 "" "* To point *" nil pt1)
        pt3 (polar pt1 (angle pt1 pt2) (* 0.2 (getvar "DIMSCALE"))) ;0.125
        )
  (setvar "orthomode" 0)
  (ARCH:CUSTOM_LAYERS-ANNO-LDR)
  (command
    "PLINE"
    pt1
    "W"
    "0"
    (* 0.065 (getvar "DIMSCALE")) ;0.0417
    pt3
    "W"
    "0"
    "0"
    pt2)
  ;;(while (setq pt2 (getpoint "\n* To point *" pt2)) (command pt2))   
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (setvar "orthomode" 1)
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (command "")
  ;;(command "change" "l" "" "p" "c" "1" "")
  (ARCH:F_R-VAR))
;;;
(defun LDR5IT  (/ pt1 pt2 pt3)
  (ARCH:F_S-VAR)
  (setvar "CMDECHO" 0)
  ;;(ARCH:CUSTOM_LAYERS-ANNO)
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (setq pt1 (ARCH:UPOINT 1 "" "* Pick arrow head start point *" nil nil)
        pt2 (ARCH:UPOINT 1 "" "* To point *" nil pt1)
        pt3 (polar pt1 (angle pt1 pt2) (* 0.2 (getvar "DIMSCALE"))) ;0.125
        )
  (setvar "orthomode" 0)
  (ARCH:CUSTOM_LAYERS-ANNO-LDR)
  (command
    "PLINE"
    pt1
    "W"
    "0"
    (* 0.065 (getvar "DIMSCALE")) ;0.0417
    pt3
    "W"
    "0"
    "0"
    pt2)
  ;;(while (setq pt2 (getpoint "\n* To point *" pt2)) (command pt2))   
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (setvar "orthomode" 1)
  (setq pt2 (getpoint "\n* To point *" pt2))
  (command pt2)
  (command "")
  ;;(command "change" "l" "" "p" "c" "1" "")
  (ARCH:F_R-VAR))
;;;
(defun LDRCIT  (/ pt1 pt2 pt3)
  (ARCH:F_S-VAR)
  (setvar "CMDECHO" 0)
  ;;(ARCH:CUSTOM_LAYERS-ANNO)
  ;;(setq tempsnap (getvar "osmode"))
  (setvar "osmode" 0)
  (setq pt1 (ARCH:UPOINT 1 "" "Pick arrow head point" nil nil)
        pt2 (ARCH:UPOINT 1 "" "To point" nil pt1)
        pt3 (polar pt1 (angle pt1 pt2) (* 0.125 (getvar "DIMSCALE"))))
  (setvar "orthomode" 0)
  (ARCH:CUSTOM_LAYERS-ANNO-LDR)
  (command
    "PLINE"
    pt1
    "W"
    "0"
    (* 0.0417 (getvar "DIMSCALE"))
    pt3
    "W"
    "0"
    "0"
    "arc")
  ;;(while (setq pt2 (getpoint "\nTo point: " pt2)) (command pt2))
  (setq pt2 (getpoint "\nTo point: " pt2))
  (command pt2)
  ;;(setvar "osmode" tempsnap)
  (command "")
  ;;(command "change" "l" "" "p" "c" "1" "")
  (ARCH:F_R-VAR))
;;;
(defun LDRXIT  (/ dist p1 p2 p3 p4 p5 p6 ortho)
  (ARCH:F_S-VAR)
  (defun dtr (d) (* pi (/ d 180.0)))
  (defun rtd (r) (* 180.0 (/ r pi)))
  (ARCH:CUSTOM_LAYERS-SYMB)
  (setq dist (* (getvar "dimscale") 0.07))
  (setq ortho (getvar "orthomode"))
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (setq P1 (getpoint "\n* Pick a Point to Begin the Polyline *"))
  (setvar "orthomode" 1)
  (setq P2 (polar P1 (dtr 90) dist))
  (setq P3 (polar P1 (dtr 270) dist))
  (setq P4 (polar P1 (dtr 0) dist))
  (setq P5 (polar P1 (dtr 180) dist))
  (setq P6 (getpoint P1 "\n* Pick next point *"))
  (command "_pline" P4 P5 P1 P2 P3 P1 P6)
  (while (> (getvar "cmdactive") 1) (command pause))
  (setvar "osmode" ortho)
  (ARCH:F_R-VAR)
  (princ))

Gary

[Joe Burke]

Alan,

The problem I'm referring to has nothing to do with WCS or UCS.

[CAB]

Well I think I have a working version.

Code: [Select]

;;  AddLeader.lsp
;;  CAB @ TheSwamp.org
;;  Test version 01.22.2008

;;================================================================
;;   Add a 3 point leader 
;;================================================================

(defun addLeader (p1 p2 p3 txt txtht just / mtextobj doc elst ent ptlist
                   gap ldrobj leaderatt mspace p4 tmparray  xdata)
  ;;  points are UCS
  ;;  just = "T" "M" "B" "MT" "MB" "U"
 
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelSpace doc))

 
  ;;  Note DimGap is negative when the Style calls for the text to be boxed
  ;;  there are occasions when DimScale is zero
  (setq gap (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE")) (getvar "DIMGAP"))))

  (setq p4 (polar p3 (angle p2 p3) gap)) ; Position for Mtext
 
  ;;  add an mtext object to associate with the leader:
  ;;  uses current text style & height, zero width mtext
  (setq mtextobj (vla-addMText mspace (vlax-3d-point (trans p4 1 0)) 0.0 txt))
  (vla-put-height mtextobj txtht)

  ;;  Adjust Mtext Justification for Left/Right Leader
  (if (> (car p3)(car p2))
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopLeft)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleLeft)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomLeft)
        )
      )
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopRight)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleRight)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomRight)
        )
      )
  )
 
  ;;  Need to reposition Mtext as changing the acAttachmentPoint will move it
  (vla-put-insertionPoint mtextobj (vlax-3d-point (trans p4 1 0)))
  (vla-update mtextobj) ; updates the screen, remove after debug
 
 
  ;; build an array of coordinates [UCS to WCS]
  (setq ptlist (apply 'append (mapcar '(lambda(x) (trans x 1 0)) (list p1 p2 p3))))

  ;;  Create the Leader & associate the text
  ;;  text is moved to position TL TR BL BR if needed
  ;;  The array of 3D WCS coordinates specifying the leader.
  (setq tmparray (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1))))
  (vlax-safearray-fill tmparray ptlist)
  ;;  not needed (setq tmp (vlax-make-variant tmparray))
  (setq ldrObj (vla-addLeader mspace tmparray mtextobj acLineWithArrow) )
  (vla-put-verticaltextposition ldrObj acVertCentered)
 
  ;;  adjust leader vector for 'Middle of Top/Bottom Line'
  (setq elst (entget (setq ent (vlax-vla-object->ename ldrObj))))

 
  (cond
    ((= just "MT") ;  Middle of Top Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht -2.0) 0.0) 1 0)) (assoc 213 elst) elst))
     (setq elst (subst (cons 211 (getvar "ucsxdir")) (assoc 211 elst) elst))
     (vla-put-insertionPoint mtextobj
       (vlax-3d-point (trans (polar (polar p3 (/ pi 2) (/ txtht 2.0)) (angle p2 p3) gap) 1 0)))
    )
   
    ((= just "MB") ;  Middle of Bottom Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht 2.0) 0.0) 1 0)) (assoc 213 elst) elst))
     (setq elst (subst (cons 211 (getvar "ucsxdir")) (assoc 211 elst) elst))
     (vla-put-insertionPoint mtextobj
       (vlax-3d-point (trans (polar (polar p3 (* pi 1.5) (/ txtht 2.0)) (angle p2 p3) gap) 1 0)))
    )
  )

  ;;==========================================
  ;;  Add Xdata needed to make this a QLeader
  ;;==========================================

  ;;  make it a QLeader
  (setq LeaderAtt (min (vl-position Just '("T" "MT" "M" "MB" "B" "U")) 4))
    (setq xdata (list (list -3
                    (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{")
                      '(1070 . 147) (cons 1040 (vla-get-textgap ldrObj)) ; Dimgap
                          '(1070 . 77) (cons 1070 0) ; Underline Text
                          '(1070 . 41) (cons 1040 (getvar "DIMASZ"))  ; Arrow head Size
                          '(1070 . 40) (cons 1040 (getvar "DIMSCALE"))  ; DIMSCALE
                          '(1002 . "}")))))
  (entmod (append elst xdata))


  ;;  Clean Up
  (vla-update ldrObj) ; updates the screen
  (vlax-release-object ldrObj)
 
  (vla-update mtextobj) ; updates the screen
  (vlax-release-object mtextobj)
  (princ)
)


;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;;                T E S T   R O U T I N E                 
;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:test (/ p1 p2 p3 LA usrorm)
  (vl-load-com)
  ;;  Get the 2nd point
  ;;  Draw temporary Leader w/ arrow using grvecs
  (defun GetPoint2 (p0 / gr org pt ang_arrow sz)
    (defun arrow (p0 arw_ang col size / p1 p2 p3)
      (setq size (* size 0.6)
            p2 (polar p0 (+ arw_ang pi) size)
            p1 (polar p2 (+ arw_ang (* pi 0.85)) size)
            p3 (polar p2 (+ arw_ang (* pi 1.15)) size))
      (grvecs (list col p0 p1 p1 p2 p2 p3 p3 p0))
    )
 
    (setq sz (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE"))
                    (getvar "DIMASZ"))))
    (while
      (cond
        ((= (car (setq gr (grread nil 7))) 5)
          (setq pt        (cadr gr)
                ang_arrow (angle pt p1)
          )
          (redraw)
          (arrow p1 ang_arrow 256 sz)
          (grvecs (list 256 p1 pt))
         t
        )
        ((= (car gr) 3) nil)
        (t)
      )
    )
    pt
  )

  (setq usrorm (getvar "orthomode"))
  (setvar "orthomode" 0)
  (or (setq LA nil) ;"4") ; Debug
  (initget "1 2 3 4 5") ; Leader Attachment -
  (setq LA (cond ((getkword "\nAttach? 1Top 2MidTop 3Middle 4MidBottom 5Bottom:"))
                 ("1")
           )
  )
  ) ; Debug
  (if (and (setq p1 (getpoint "\nPick start of 3 point leader."))
           ;;(setq p2 (getpoint p1 "\nPick next point of leader."))
           (princ "\nPick next point of leader.")
           (setq p2 (getpoint2 p1))
      )
    (progn
      ;;(grvecs (list 256 p1 p2))
      (setvar "orthomode" 1)
      (if (setq p3 (getpoint p2 "\nPick end of leader."))
        (if (equal (car p2) (car p3) 0.001)
          (if (> (car p1)(car p2)) ; Leader is Right
            (setq p3 (subst (car p2) (- (car p3) 0.0001) p3))
            (setq p3 (subst (car p2) (+ (car p3) 0.0001) p3))
          )
          (setq p3 (subst (cadr p2) (cadr p3) p3))
        )
      )
      (redraw)
      (if (and p1 p2 p3)
        (progn
          (addLeader p1 p2 p3
                     "This is a test\\PSecond Line\\PThird Line"
                     (getvar "TEXTSIZE")
                     (nth (atoi LA) '("" "T" "MT" "M" "MB" "B" "U"))
          )
        )
      )
    )
  )
  (setvar "orthomode" usrorm)
  (princ)
)

[T.Willey]

Alan,

  I tried the new version, and got this error at the command line.

Command: test

Attach? 1Top 2MidTop 3Middle 4MidBottom 5Bottom:2

Pick start of 3 point leader.
Pick next point of leader.
Pick end of leader.; error: Automation Error. Description was not provided.

The text was inserted, but the leader was never drawn.  I had rotated my ucs around the Z axis 90 degrees.

Worked fine in wcs.

[T.Willey]

The problem existed because the leaders second leg was not along the new X axis, but along the Y axis.  When I drew it along the X axis, it worked as expected.

[CAB]

Yes, thanks.
I just updated the TEST.lsp above to fix that problem, short term. 

[Joe Burke]

Alan,

I tried the latest version. The problem I mentioned before is fixed now.

[CAB]

This is a little off the subject, but I have quit using the leader command, and use my own polyline leader that I place first, followed up with dtext afterwards.
Gary

Thanks Gary,
My intention was to try & tame the QLeader with my routine. I have quite a few pline leader routines and use 2 of them in my TextInsert.lsp. routine. I wanted to remove the use of COMMAND in that lisp when the Qleader is created. I think I can do that now.
I will take a look at pline leader routine you posted. Thanks for to contribution.

[CAB]

Thanks to both Joe & Tim for the test runs.

I've added an error trap & changed the point list to except any number of points to make to routine more vestal.
Still testing this version & will post soon.

There is an error in the vla-addleader when in Isometric View that I can't explain. All others seem to work though.

[ttechnik]

Hi,
vla-put-verticaltextposition is good.
bye

Code: [Select]

;;  AddLeader.lsp
;;  CAB @ TheSwamp.org
;;  Test version 01.22.2008

;;================================================================
;;   Add a 3 point leader 
;;================================================================

(defun addLeader (p1 p2 txt txtht just just_mtext_on_leader / mtextobj doc elst ent ptlist
                   gap ldrobj leaderatt mspace p4 tmparray  xdata)
  ;;  points are UCS
  ;;  just = "T" "M" "B" "MT" "MB" "U"
 
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelSpace doc))

 
  ;;  Note DimGap is negative when the Style calls for the text to be boxed
  ;;  there are occasions when DimScale is zero
  (setq gap (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE")) (getvar "DIMGAP"))))

  (setq p4 (polar p2 (angle p1 p2) gap)) ; Position for Mtext
 
  ;;  add an mtext object to associate with the leader:
  ;;  uses current text style & height, zero width mtext
  (setq mtextobj (vla-addMText mspace (vlax-3d-point (trans p4 1 0)) 0.0 txt))
  (vla-put-height mtextobj txtht)

  ;;  Adjust Mtext Justification for Left/Right Leader
  (if (> (car p2)(car p1))
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopLeft)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleLeft)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomLeft)
        )
      )
      (cond
        ((or (= just "T")(= just "MT"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointTopRight)
       )
        ((= just "M")
          (vla-put-attachmentPoint mtextobj acAttachmentPointMiddleRight)
        )
        ((or (= just "B")(= just "MB")(= just "U"))
          (vla-put-attachmentPoint mtextobj acAttachmentPointBottomRight)
        )
      )
  )
 
  ;;  Need to reposition Mtext as changing the acAttachmentPoint will move it
  (vla-put-insertionPoint mtextobj (vlax-3d-point (trans p4 1 0)))
  (vla-update mtextobj) ; updates the screen, remove after debug
 
 
  ;; build an array of coordinates [UCS to WCS]
  (setq ptlist (apply 'append (mapcar '(lambda(x) (trans x 1 0)) (list p1 p2 ))))

  ;;  Create the Leader & associate the text
  ;;  text is moved to position TL TR BL BR if needed
  ;;  The array of 3D WCS coordinates specifying the leader.
  (setq tmparray (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1))))
  (vlax-safearray-fill tmparray ptlist)
  ;;  not needed (setq tmp (vlax-make-variant tmparray))
  (setq ldrObj (vla-addLeader mspace tmparray mtextobj acLineWithArrow) )
 
  ;;  adjust leader vector for 'Middle of Top/Bottom Line'
  (setq elst (entget (setq ent (vlax-vla-object->ename ldrObj))))

 
  (cond
    ((= just "MT") ;  Middle of Top Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht -2.0) 0.0) 1 0)) (assoc 213 elst) elst))
     (setq elst (subst (cons 211 (getvar "ucsxdir")) (assoc 211 elst) elst))
     (vla-put-insertionPoint mtextobj
       (vlax-3d-point (trans (polar (polar p2 (/ pi 2) (/ txtht 2.0)) (angle p1 p2) gap) 1 0)))
    )
   
    ((= just "MB") ;  Middle of Bottom Line Justification Adjustment
     (setq elst (subst (cons 213 (trans (list 0.0 (/ txtht 2.0) 0.0) 1 0)) (assoc 213 elst) elst))
     (setq elst (subst (cons 211 (getvar "ucsxdir")) (assoc 211 elst) elst))
     (vla-put-insertionPoint mtextobj
       (vlax-3d-point (trans (polar (polar p2 (* pi 1.5) (/ txtht 2.0)) (angle p1 p2) gap) 1 0)))
    )
  )

  ;;==========================================
  ;;  Add Xdata needed to make this a QLeader
  ;;==========================================

  ;;  make it a QLeader
;;;;;;;;;;;;;;;;;;;;;  (setq LeaderAtt (min (vl-position Just '("T" "MT" "M" "MB" "B" "U")) 4))?????????????????????????
    (setq xdata (list (list -3
                    (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{")
                      '(1070 . 147) (cons 1040 (vla-get-textgap ldrObj)) ; Dimgap
                          '(1070 . 77) (cons 1070 0) ; Underline Text
                          '(1070 . 41) (cons 1040 (getvar "DIMASZ"))  ; Arrow head Size
                          '(1070 . 40) (cons 1040 (getvar "DIMSCALE"))  ; DIMSCALE
                          '(1002 . "}")))))
  (entmod (append elst xdata))
  (vla-put-verticaltextposition ldrObj just_mtext_on_leader);!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! here!!!!!!!!

  ;;  Clean Up
  (vla-update ldrObj) ; updates the screen
  (vlax-release-object ldrObj)
 
  (vla-update mtextobj) ; updates the screen
  (vlax-release-object mtextobj)
  (princ)
)


;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;;                T E S T   R O U T I N E                 
;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:test (/ p1 p2 p3 LA usrorm just_mtext_on_leader)
  (vl-load-com)
  ;;  Get the 2nd point
  ;;  Draw temporary Leader w/ arrow using grvecs

 
  (defun GetPoint2 (p0 / gr org pt ang_arrow sz)
    (defun arrow (p0 arw_ang col size / p1 p2 p3)
      (setq size (* size 0.6)
            p2 (polar p0 (+ arw_ang pi) size)
            p1 (polar p2 (+ arw_ang (* pi 0.85)) size))
;;;            p3 (polar p2 (+ arw_ang (* pi 1.15)) size))
      (grvecs (list col p0 p1 p1 p2 p2 p0))
    )
 
    (setq sz (abs(* (if (zerop (getvar "DIMSCALE")) 1. (getvar "DIMSCALE"))
                    (getvar "DIMASZ"))))
    (while
      (cond
        ((= (car (setq gr (grread nil 7))) 5)
          (setq pt        (cadr gr)
                ang_arrow (angle pt p1)
          )
          (redraw)
          (arrow p1 ang_arrow 256 sz)
          (grvecs (list 256 p1 pt))
         t
        )
        ((= (car gr) 3) nil)
        (t)
      )
    )
    pt
  )



 
  (setq usrorm (getvar "orthomode"))
  (setvar "orthomode" 0)
;;;;;;;;;;;;  (or (setq LA nil) ;"4") ; Debug
  (initget "1 2 3 4 5") ; Leader Attachment -
  (setq LA (cond ((getkword "\nAttach? 1Top 2MidTop 3Middle 4MidBottom 5Bottom:"))
                 ("1")
           )
  )
  (initget "0 1") ; Mtext pos
  (setq just_mtext_on_leader (cond ((getkword "\nMtext on leader? 0Mid 1Top:"))
                 ("1")
           )
  )
;;;;;;;;;;;;  ) ; Debug
  (if (and (setq p1 (getpoint "\nPick start of 3 point leader."))
           (princ "\nPick next point of leader.")
           (setq p2 (getpoint2 p1))
      )
    (progn
      (setvar "orthomode" 1)
      (redraw)
      (if (and p1 p2 )
        (progn
          (addLeader p1 p2
            "This is a test\\PSecond Line\\PThird Line"
            (getvar "TEXTSIZE")
            (nth (atoi LA) '("" "T" "MT" "M" "MB" "B" "U"))
    just_mtext_on_leader
  )
        )
      )
    )
  )
  (setvar "orthomode" usrorm)
  (princ)
)

[CAB]

Welcome to the Swamp and thanks for that tip.
My Dim setting are always ABOVE so it was a non factor but I can see it could cause unwanted results.
I assume that Text Position for leader is only controlled by the Dimension Style settings.