Author Topic: Roll Your Own Leader Routine, Need UCS help  (Read 9824 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #15 on: January 22, 2008, 10:24:10 AM »
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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #16 on: January 22, 2008, 10:34:45 AM »
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

  • Water Moccasin
  • Posts: 2081
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #17 on: January 22, 2008, 10:41:24 AM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

Joe Burke

  • Guest
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #18 on: January 22, 2008, 10:46:23 AM »
Alan,

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

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #19 on: January 22, 2008, 10:59:19 AM »
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)
)


« Last Edit: January 22, 2008, 11:25:32 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #20 on: January 22, 2008, 11:09:22 AM »
Alan,

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

Quote
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #21 on: January 22, 2008, 11:18:43 AM »
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #22 on: January 22, 2008, 11:26:29 AM »
Yes, thanks.
I just updated the TEST.lsp above to fix that problem, short term.  :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #23 on: January 23, 2008, 05:13:17 AM »
Alan,

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

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #24 on: January 23, 2008, 09:19:57 AM »
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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #25 on: January 23, 2008, 09:25:05 AM »
Thanks to both Joe & Tim for the test runs. 8-)

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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ttechnik

  • Newt
  • Posts: 24
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #26 on: February 05, 2012, 08:54:58 AM »
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)
)
Tamás Csepcsényi

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Roll Your Own Leader Routine, Need UCS help
« Reply #27 on: February 05, 2012, 10:45:15 AM »
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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.