Ron, could you please comment a little on your align multileader program, I have created a program that will allow text to extend under the dogleg, however, when I use this, and then try to align the multileaders, your program no longer aligns them properly. I do believe it has to do with me assigning a negative leader gap, but when ever I attempt to align the leaders, I can never seem to get it to calculate the new dog leg length properly. I would think it would be as simple as taking the original length difference, and then adding the negative value to the length. but that doesnt seem to work.
Here is what I have:
(defun c:mlgap (/ obj objent objentdata
1stlinelnth lstln 1stlinelst strlnt
exlandln line llinelnth vlaobjent
linelnth lndif lnchng lngap
landinggap leglen lncoord1 lncoord2
)
(if (setq obj (ssget))
(progn
(setq
objent (ssname obj 0)
objentdata (entget objent)
vlaobjent (vlax-ename->vla-object objent)
linelnth 0
) ;_ select object
(typecheck)
(if (equal (assoc 0 objentdata) '(0 . "MULTILEADER"))
(if (equal (car (cdr (assoc 11 (reverse objentdata)))) -1.0)
(progn
;(setq tlocat (cdr (assoc 12 objentdata)))
(setq 1stlinelnth (cdr (assoc 304 objentdata))
1stlinelst (str2list 1stlinelnth "\\P")
lstln (length 1stlinelst)
) ;_ end of setq
(if (= Standardtype "ALLEGAN")
(setq lngap 0.05
) ;_ end of setq
(setq lngap 0.04
) ;_ end of setq
) ;_ end of if
(foreach line 1stlinelst
(setq
strlnt (car (cadr (textbox (list (cons 1 line)
(cons 7 "DIM")
(cons 41 1.0)
(cons 40 (* lngap 2))
) ;_ end of list
) ;_ end of textbox
) ;_ end of cadr
) ;_ end of car
) ;_ end of setq
(if (= llinelnth nil)
(setq llinelnth strlnt)
) ;_ end of if
(if (< linelnth strlnt)
(setq linelnth strlnt)
) ;_ end of if
) ;_ end of foreach
(setq lndif (- linelnth llinelnth))
(setq landinggap (* -1 (- lndif lngap)))
(setq leglen (vlax-get-property vlaobjent 'DogLegLength))
(vlax-put-property vlaobjent 'LandingGap landinggap)
(setq txtbseptx (car (cdr (assoc 10 objentdata)))
txtbsepty (cadr (cdr (assoc 10 objentdata))))
(if (> (+ (+ llinelnth lngap) (/ leglen 2)) (+ linelnth lngap))
(setq lncoord1 (strcat (rtos (+ txtbseptx (+ (+ llinelnth lngap) (/ leglen 2))) 2 2) "," (rtos (+ txtbsepty (* 2 lngap)) 2 2) ",0")
lncoord2 (strcat (rtos (- (+ landinggap txtbseptx) lngap) 2 2) "," (rtos (- (+ txtbsepty lngap) (/ (* lstln (/ (* 100 lngap) 30)))) 2 2) ",0"))
(setq lncoord1 (strcat (rtos (+ txtbseptx (+ linelnth lngap)) 2 2) "," (rtos (+ txtbsepty (* 2 lngap)) 2 2) ",0")
lncoord2 (strcat (rtos (- (+ landinggap txtbseptx) lngap) 2 2) "," (rtos (- (+ txtbsepty lngap) (/ (* lstln (/ (* 100 lngap) 30)))) 2 2) ",0"))
)
(vl-cmdf
"stretch"
"c"
lncoord1
lncoord2
""
"0,0,0"
(strcat
(rtos (+ (* (* -1 landinggap) 2) (* 2 lngap)) 2 4)
",0,0"
) ;_ end of strcat
) ;_ end of vl-cmdf
) ;_ end of progn
)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
(defun Str2List (str pat / i j n lst)
(cond
((/= (type str) (type pat) 'STR))
((= str pat) '(""))
(T
(setq i 0
n (strlen pat)
) ;_ end of setq
(while (setq j (vl-string-search pat str i))
(setq lst (cons (substr str (1+ i) (- j i)) lst)
i (+ j n)
) ;_ end of setq
) ;_ end of while
(reverse (cons (substr str (1+ i)) lst))
)
) ;_ end of cond
) ;_ end of defun
you could possibly have issues with the typecheck function and standardtype, as they are run from a separate file, just rem typecheck out and force lngap to be .05 and the text height is .1
here is what I have so far in modifying your program:
(defun c:multileaderalign
(/ al alpt cnt d1 dif dll doc el obj pt pt2 pt3 ss xpt lng tht)
(setq doc (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(if (and (setq ss (ssget '((0 . "MULTILEADER"))))
(setq al (car (entsel "\nSelect leader to align to: ")))
(setq alpt (cdr (assoc 10 (entget al))))
(setq xpt (car alpt))
) ;_ end of and
(progn
(vla-EndUndoMark doc)
(vla-StartUndoMark doc)
(foreach ml
(vl-remove
al
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of vl-remove
(setq obj (vlax-ename->vla-object ml)
el (entget ml)
pt (cdr (assoc 10 el))
pt2 (list xpt (cadr pt))
dif (distance pt pt2)
dll (vla-get-DoglegLength obj)
pt3 (polar pt (angle pt pt2) dll)
d1 (distance pt alpt)
cnt 0
) ;_ end of setq
(if (= (vla-get-DogLegged obj) :vlax-true)
(progn
(while (and (not (equal pt2 xpt 0.01))
(<= cnt 2)
) ;_ end of and
(setq dif (* -1 dif))
[color=red](if (/= (vla-get-landinggap obj) (/ (vla-get-textheight obj) 2))
(setq lng (* -5 (vla-get-landinggap obj))
tht (/ (* (vla-get-textheight obj) 1.02) -2))
(setq lng 0
tht 0)
)
(vla-put-DoglegLength obj (+ dll dif tht lng))[/color]
(vla-update obj)
(setq el (entget (vlax-vla-object->ename obj))
pt (cdr (assoc 10 el))
pt2 (car pt)
cnt (1+ cnt)
) ;_ end of setq
) ;_ end of while
) ;_ end of progn
) ;_ end of if
) ;_ end of foreach
(vla-EndUndoMark doc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
I think the area highlighted in red is what I should be changing, but I cant get it to work.
Thanks for looking at this and setting me in the right direction.