I am rewriting my program to draw leaders, for various reasons, part of the program automatically lines up the leaders when they get close. I have been able to do this with ortho and polarmode turned off, no problem. But once I turn one of these on, I cannot get it to line up properly. I previously drew plines and used intersectwith to figure this out, but doing so slows down the routine a bit and I want to eliminate the need to do so.
Here is the code that I have so far (please note that this code is very far from being completed, but I want to make this work properly before adding everything else in):
(vl-cmdf "._-insert" "Uleader.dwg")(command); Insert in leader styles
(defun c:Uleader ( / *thisdrawing* *modelspace* *paperspace* *path* *IsCivil* *Prompt* *note* *poc* pos Pt1 Pt1Tst Pt2 Pt3 NewPoints StopLoop input code data FxPointv mlobj ax SnapAng sc AutoAlign FxPt2 FxPt3 Ang1 Line1 Line2)
;Supporting Functions
(defun PolarRound (ang deg)
(* (/ pi (/ 180 (r2d deg))) (fix (/ (+ (/ pi (/ 360 (r2d deg))) ang) (/ pi (/ 180 (r2d deg))))))
)
;; by CAB 10/05/2007
;; Expects pts to be a list of 2D or 3D points
;; Returns new pline object
(defun makePline (spc pts)
;; flatten the point list to 2d
(if (= (length (car pts)) 2) ; 2d point list
(setq pts (apply 'append pts))
(setq pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
)
(setq
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts
)
)
)
(vla-addlightweightpolyline spc pts)
)
(defun bitcodef (value bit)
;; Originally Written by Lee Ambrosius on: 6/6/04
;; Modified by Chris Wade 1/13/2010
(if (zerop(logand bit value))
nil
T
);;
) ;defun bitcode
; Convert value in degrees to radians
(defun D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
) ;_ end of defun
(defun R2D (nbrOfRadians)
(* 180.0 (/ nbrOfRadians pi))
)
;End of supporting functions
(if (not (tblsearch "LAYER" "LEADER")) ; Check to see if layer exsists
(progn
(if (= 1 (getvar "pstylemode")); Add code to determine if layer already exists
(progn
(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "")
)
(progn
(command "._-layer" "n" "LEADER" "color" "WHITE" "" "lweight" "DEFAULT" "" "ltype" "CONTINUOUS" "" "pstyle" "BLACK" "" "")
)
)
)
)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ; Sets the drawing based variables
*modelspace* (vla-get-ModelSpace *thisdrawing*)
*paperspace* (vla-get-PaperSpace *thisdrawing*)
*path* (getvar "dwgprefix")
AutoAlign "")
(If (> (strlen *path*) 5)
(progn
(setq pos (vl-string-position (ascii "\\") *Path* (+ (vl-string-position (ascii "\\") *path* 5) 1)))
(If (or (= (strcase (substr *path* (+ pos 8) 1)) "C") (= (getvar "USERS5") "CIVIL"))
(setq *IsCivil* T)
)
)
)
(setvar "annoautoscale" 4)
(if (= *Content* nil)
(setq *Content* "MTEXT")
)
;End of setting drawing based variables
(while (= pt1 nil)
(setq Pt1 (getpoint "\nSelect starting point of leader: "))
(if (= pt1 nil)
(princ "\r*** You must select a starting point for the leader ***")
)
)
(if (= *IsCivil* T)
(SETVAR "CMLEADERSTYLE" "CIVIL")
(progn
(setq Pt1Tst (osnap Pt1 "_NEA"))
(If (= Pt1Tst nil)
(SETVAR "CMLEADERSTYLE" "BEINOB-R1")
(SETVAR "CMLEADERSTYLE" "BEIOB-R1")
)
)
)
(setq pt2 (trans (cadr (grread t 4 4)) 1 0))
(if (> (car pt1) (car pt2))
(setq pt3 (polar pt2 (* pi (/ 180 180.0)) 0.25))
(setq pt3 pt2)
)
(setq newpoints (vlax-make-safearray vlax-vbDouble '(1 . 6)))
(vlax-safearray-put-element newpoints 1 (car pt1))
(vlax-safearray-put-element newpoints 2 (cadr pt1))
(vlax-safearray-put-element newpoints 3 (caddr pt1))
(while (= StopLoop nil)
(setq *Prompt* "\rSpecify second leader point ")
(if (= *note* T)
(setq *prompt* (strcat *prompt* "** Note **"))
(setq *prompt* (strcat *prompt* "Note"))
)
(if (= *typ* T)
(setq *prompt* (strcat *prompt* "/" "** Typ **"))
(setq *prompt* (strcat *prompt* "/" "Typ"))
)
(cond
((= *poc* nil)
(setq *prompt* (strcat *prompt* "/" "Poc(d)"))
)
((= *poc* "-POC")
(setq *prompt* (strcat *prompt* "/" "** Poc **"))
)
((= *poc* "-POD")
(setq *prompt* (strcat *prompt* "/" "** Pod **"))
)
)
(if (= *IsCivil* T)
(setq *prompt* (strcat *prompt* "/" "** Civil **"))
(setq *prompt* (strcat *prompt* "/" "Civil"))
)
(setq *prompt* (strcat *prompt* "/Arrowheads/cOntent: " AutoAlign))
(princ *prompt*)
(setq input (grread t 4 4)
code (car input)
data (cadr input)
)
(cond
((= code 3)
(setq StopLoop T)
)
((= code 5)
(if (/= data nil)
(progn
(setq FxPt (trans data 1 0))
(if (> (car pt1) (car FxPt))
(setq FxPt (polar FxPt (d2r 180) 0.18))
)
(cond
((= (getvar "orthomode") 1)
(setq SnapAng (d2r 90))
)
((= (bitcodef (getvar "autosnap") 8) T)
(setq SnapAng (getvar "polarang"))
)
(T
(setq SnapAng 0)
)
)
(if (> SnapAng 0)
(setq FxPt (polar pt1 (PolarRound (angle pt1 FxPt) SnapAng) (distance pt1 FxPt)))
)
(if (not (acet-sys-shift-down))
(progn
(setq AutoAlign "")
(if (/= UlLastPoint nil)
(progn
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq sc (/ 1 (getvar "cannoscalevalue")))
(setq sc 1)
)
(if (< (distance FxPt (list (car UlLastPoint) (cadr FxPt))) (* 0.5 sc))
(progn
(setq AutoX T)
(if (> SnapAng 0)
(Progn
(setq FxPt (list (car UlLastPoint) (cadr FxPt)); When turned on, it doesn't work.
Ang1 (PolarRound (angle Pt1 FxPt) SnapAng)
FxPt (polar Pt1 Ang1 (distance pt1 (list (car UlLastPoint) (cadr FxPt))))
)
)
(setq FxPt (list (car UlLastPoint) (cadr FxPt))); This works fine when orthomode and snapang are turned off
)
)
(progn
(setq AutoX nil)
(if (< (distance FxPt (list (car FxPt) (cadr UlLastPoint))) (* 0.5 sc))
(setq AutoY T)
(setq AutoY nil)
)
)
)
)
)
)
(setq AutoAlign " (Autoalign Overide Activated)")
)
(vlax-safearray-put-element newpoints 4 (car FxPt))
(vlax-safearray-put-element newpoints 5 (cadr FxPt))
(vlax-safearray-put-element newpoints 6 (caddr FxPt))
(if (and (/= mlobj nil) (not (vlax-erased-p mlobj)))
(vla-delete mlobj)
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq mlobj (vla-AddMleader *modelspace* newpoints 0))
(setq mlobj (vla-AddMleader *paperspace* newpoints 0))
)
(setq ax (vla-get-dogleglength mlobj))
(if (> (car pt1) (car FxPt))
(progn
(vla-put-dogleglength mlobj 0); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
; Code from: http://www.theswamp.org/index.php?topic=30817.0
(vla-SetDogLegDirection mlobj 0 (vlax-3D-point (list (if (<= (car pt1) (car FxPT)) 1 -1) 0 0)))
; End of code from: http://www.theswamp.org/index.php?topic=30817.0
(vla-put-dogleglength mlobj ax); This code is from http://www.theswamp.org/index.php?topic=31348.msg369336#msg369336
)
)
(vla-put-Layer mlobj "leader")
)
)
)
)
)
(setq UlLastPoint FxPt)
)
As you can see, theswamp has been very helpful in getting this to work, even in it's original form, so I would like to thank everyone for that help.
Please note that you will need the uleader.dwg file in a location that AutoCAD can find it.