Jump to content

Using Trans for UCS coordinate callouts - Causing leader to run off in odd direction


Final7C

Recommended Posts

Ok. So I'm using a lisp routine that has been previously set up. It wouldn't display any of the current UCS coordinates. I think I fixed that. But now, I have caused a problem with the leaders. Specifically the line that is supposed to go underneath the N but above the easting. In WCS it works out just fine, but in the UCS it shoots off up and right. usually based on how far I am from the World Origin. Help! Below is the code. (Sadly I don't know exactly where the problem is)

 

Main Function---------------------------------------------------------------------------
;;;Function draws a leader with no text.
(defun bmcdNE (wLeader wElev wa / ap np ep N E)

(BMCDTextStyles) ;load standard text styles
(BMCDDimStyles) ;load standard dim styles

;save variables
(NEsave-vars)
; setup error handler here
(setvar "cmdecho" 0)
(setq *error* leader-error)
;check and set dscale
(if (= dscale nil)
(setq dscale (getvar "dimscale"))
);end if

(QlSave);saves current settings
;Now we need to set the current settings for the needed leader
(setq NoText '(4 ;1. AnnoType 60 0Mtext<def> 1Copy 2Tolerance 3BlockReference 4None
0 ;2. ReuseAnno 61 0None<def> 1Next 2Current
1 ;3. LeftAttach 62 0TopOfTop 1MiddleOfTop<def> 2Middle 3MiddleOfBottom 4BottomOfBottom
3 ;4. RightAttach 63 0TopOfTop 1MiddleOfTop 2Middle 3MiddleOfBottom<def> 4BottomOfBottom
0 ;5. Underline 64 1On 0Off<def>
0 ;6. Splined 65 1On 0Off<def>
1 ;7. NoPointLimit 66 1On 0Off<def>
2 ;8. NumPoints 67 Integer (Must be greater than 2) 3<def>
0 ;9. Wordwrap 68 1On<def> 0Off
1 ;10. AlwaysLeftJust 69 1On 0Off<def>
0 ;11. Angle1 70 0Any<def> 1Horizontal 2?d 3Ed 40d 5 d
0 ;12. Angle2 71 0Any<def> 1Horizontal 2?d 3Ed 40d 5 d
0 ;13. Box 72 1On 0Off<def>
0.0 ;14. Textwidth 40 Real (Must be > 0.0) 0.0<def>
"." ;15. Arrowname 3 String (or User defined arrow as block name) See definitions below
));end setq 
(command "osnap" "end,mid,intersection,center")


(SetQleader NoText)
(setvar "dimlwd" -1)
(setvar "texteval" 1)
(setvar "orthomode" 0) 
(setq style (cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))) ;gets the text height from style.
(setq comp (cdr(assoc 41 (tblsearch "style" (getvar "textstyle"))))) ;stores the compression factor.
(if (= 0 style) (setq ts (getvar "textsize"))) ;sets the text size to the active textsize.
(if (/= 0 style) (setq ts style)) ;sets the text size to the style size.
(command "layer" "set" "G-ANNO-TEXT" "") 
(setq pt1 (getpoint "\nEnter starting point:")) ;Gets the first point for the
;coordinate and line. 

(setvar "osmode" 0)
(setvar "luprec" 2) 

(setq save-pt1 pt1) 

;;; ;do we need to covert the point from pspace to mspace?
(if (= (getvar "tilemode") 0)
(setq cs_from 0) ;WCS
(setq cs_to 1) ;UCS
(setq pt1 (trans pt cs_from cs_to 0) ; disp = 0 indicateds that pt is a point
)

(setq x1 (car pt1)) ;Stores the x coord of the first point.
(setq y1 (cadr pt1)) ;Stores the y coord of the first point.
(setq z1 (caddr pt1)) ;stores the z coord of the first point. JAH

(setq xabs (abs x1)) ;Gets the absolute value of the x point.
(setq yabs (abs y1)) ;Gets the absolute value of the y point.
(setq zabs (abs z1)) ;Gets the absolute value of the z point. AMS

(setq x (rtos xabs (getvar "lunits") (+(getvar "luprec")0))) ;Converts the x coord from real to string.
(setq y (rtos yabs (getvar "lunits") (+(getvar "luprec")0))) ;Converts the y coord form real to string.
(setq z (rtos zabs (getvar "lunits") (+(getvar "luprec")0))) ;Converts the z coord form real to string. JAH

;if the number of decimal places is less than the precission add zeros
(while (< (strlen (substr x (+(vl-string-search "." x) 2))) (getvar "luprec"))
(setq x (strcat x "0"))
)

;if the number of decimal places is less than the precission add zeros
(while (< (strlen (substr y (+(vl-string-search "." y) 2))) (getvar "luprec"))
(setq y (strcat y "0"))
)
;if the number of decimal places is less than the precission add zeros
(while (< (strlen (substr z (+(vl-string-search "." z) 2))) (getvar "luprec"))
(setq z (strcat z "0"))
) 

(setq IN x) ;Sets variable for subroutine.
(COMMA) ;CALLS SUBROUTINE.
(setq x OUT) ;Saves variable from subroutine.
(setq IN y) ;Sets variable for subroutine.
(COMMA) ;CALLS SUBROUTINE.
(setq y OUT) ;Saves variable from subroutine.
(setq IN z) ;Sets variable for subroutine.
(COMMA) ;CALLS SUBROUTINE.
(setq z OUT) ;Saves variable from subroutine. 

(setq pt1 save-pt1 )

(if (> X1 0)
(setq E (strcat "E " x )) ;Checks to see if X coordinate
)
(if(< X1 0)
(setq E (strcat "W " x )) ;is positive or negitive
)
(if(= X1 0)
(setq E (strcat "BASELINE " x )) ;and sets the proper label.
)
(if(> Y1 0)
(setq N (strcat "N " y )) ;Checks to see if Y coordinate
)
(if(< Y1 0)
(setq N (strcat "S " y )) ;is positive or negitive
)
(if(= Y1 0)
(setq N (strcat "BASELINE " y )) ;and sets the proper label.
) 
(setq ABC "ABC ") 
;;;build the elevation label
(setq Zelev (strcat "EL " z)) 

(setq nl (strlen N)) ;Gets the string length of the N variable.
(setq el (strlen E)) ;Gets the string length of the E variable.
(cond
((> nl el) (setq ll nl)) ;Tests to see if the N var is longer than
;the E var.
((> el nl) (setq ll el)) ;Tests to see if the E var is longer than
;the N var.
((= nl el) (setq ll nl)) ;Tests to see if the N and E var are equil.
) ;end cond 
(setq pt2 (getpoint pt1 "\nEnter second point:")) ;The pt1 is used to create
;a rubberband line.
(grdraw pt1 pt2 -1) ;Draws a tempory line to let you see
;where you are and what is going on.
(setq x2 (car pt2)) ;Stores the Second X point
(setq y2 (cadr pt2)) ;Stores the Second Y point
(setq pt3 (getpoint pt2 "Enter side to offset:")) ;The pt2 is used to create
;a rubberband line.
(setq x3 (car pt3)) ;Stores the Third X point
(setq y3 (cadr pt3)) ;Stores the Third Y point
(cond
((> x2 x3) (setq lx (- x2 (* 0.8 ts ll comp)))) ;Checks to see wich way
((> x3 x2) (setq lx (+ x2 (* 0.8 ts ll comp)))) ;you are drawing the line
) ;and sets the end of line
;to match the text length.
(cond
((> x2 x3) (setq tx lx)) ;Based on the direction of the line
((> x3 x2) (setq tx (+ x2 ts))) ;the text X point is calculated.
)
(setq ta (+ y2 (* ts 3)))
(setq ap (list tx ta)) 
(setq tn (+ y2 ts)) ;Calculates the Y point for North or South text.
(setq np (list tx tn)) ;Creates the point to place the text.
(setq te (- y2 ts )) ;Calculates the Y point for East or West test.
(setq ep (list tx te)) ;Creates the point to place the text.
(setq tElev (- y2 (* ts 3))) ;Calculates the Y point for Elevation text.
(setq elevP (list tx tElev)) ;Creates the point to place the text.

(setq ly y2) ;Sets the last Y point EQ. to the second Y point.
(setq pt4 (list lx ly)) ;Creates the point for the end of the line.
(command "pline" pt2 pt4 "") ;Places the line.
(setq theline (vlax-ename->vla-object (entlast))) ;get the line object 
(if (= style 0) (command "text" "J" "ML" np ts "0" N)) ;Places the top text.
(if (/= style 0) (command "text" "J" "ML" np "0" N)) ;Places the top text.
(setq toptext (vlax-ename->vla-object (entlast))) ;get the text object

(if (= style 0) (command "text" "J" "ML" ep ts "0" E)) ;Places the bottom text.
(if (/= style 0) (command "text" "J" "ML" ep "0" E)) ;Places the bottom text.
(setq bottomtext (vlax-ename->vla-object (entlast))) ;get the text object
(if wa
(progn
(if (= style 0) (command "text" "J" "ML" ap ts "0" ABC))
(if (/= style 0) (command "text" "J" "ML" ap "0" ABC))
(setq atext (vlax-ename->vla-object (entlast)))
)
)
;;;Create the text for the elevation text
(if wElev
(progn
(if (= style 0) (command "text" "J" "ML" elevP ts "0" Zelev)) ;Places the bottom text.
(if (/= style 0) (command "text" "J" "ML" elevP "0" Zelev)) ;Places the bottom text.
(setq Elevtext (vlax-ename->vla-object (entlast))) ;get the text object
);end progn
);end if
;rotate the text and line to make it horizontal
(setq viewrotation (getvar "viewtwist")) ;ucs twist
(setq retval (vla-rotate theline (vlax-3d-point pt2) (* viewrotation -1)))
(setq retval (vla-rotate toptext (vlax-3d-point pt2) (* viewrotation -1)))
(setq retval (vla-rotate bottomtext (vlax-3d-point pt2) (* viewrotation -1)))
(if wa
(setq retval (vla-rotate atext (vlax-3d-point pt2) (* viewrotation -1)))
)
(if wElev
(setq retval (vla-rotate Elevtext (vlax-3d-point pt2) (* viewrotation -1)))
);end if 

;;;get the end point of the now rotated line this will also be the endpoint for the qleader
(setq theLineCoords (vlax-variant-value (vla-get-Coordinates theline)))
(setq newXPt (vlax-safearray-get-element theLineCoords 0))
(setq newYPt (vlax-safearray-get-element theLineCoords 0))
(setq newEndPt (list newXPt newYPt))
;in order to avoid the the mtext dialog we set the default qleader settings above
(setq ss (ssget "_X" (list (cons 0 "*MTEXT,TEXT")(cons 1 "Ex. TP*")))) 
(if wLeader 
(progn
(vl-cmdf "qleader" pt1 pt2 newEndPt "")
(vla-delete theline) ;delete our temp line
);end progn
);end if
(Merge) 

(QlRestore)
(setvar "cmdecho" 1) ;Turns on the command echo.

(redraw)
(NErestore-vars)
(princ)
);end defun


(defun c:LNE ()
(bmcdNE T nil nil)
(princ)
);end defun
(defun c:LNEL ()
(bmcdNE T nil T)
(princ)
);end defun
(defun c:LNEEL ()
(bmcdNE T T T)
(princ)
);end defun
(defun c:LNEE ()
(bmcdNE T T nil)
(princ)
);end defun
(defun c:NEE ()
(bmcdNE nil T nil)
(princ)
);end defun
(defun c:NEEL ()
(bmcdNE nil T T)
(princ)
);end defun
(defun c:NEL ()
(bmcdNE nil nil T)
(princ)
);end defun
(defun c:NE ()
(bmcdNE nil nil nil)
(princ)
);end defun

 

I am using "lneel" as my command.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...