[编程交流] 对UCS坐标使用Trans

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