Code Red > AutoLISP (Vanilla / Visual)
Automatically rotate designator
(1/1)
Craig:
Well, I've got this program written but I want to remove the section that ask about rotating the text. I've tried to think of a way to where it will always read correctly from the bottom of the shete and from the titleblock to the right. Basically calculate the correction. Any ideas? Look for ;;;;; I'd like to remove this section below
--- Code: ---(defun c:line_id (/ cmd mecTxtSize
mecGetLayer mecSelLine mecLineLength
mecLineLayer mecLineAngle mecGetPoint
)
(setq cmd (getvar 'cmdecho))
(setq osm (getvar 'osmode))
(setq mecTxtSize (getvar 'textsize))
(setq mecGetLayer (getvar 'clayer))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq mecSelLine
(vlax-ename->vla-object
(car (entsel "\nSelect conduit line to label: "))
)
)
(while (/= mecSelLine nil)
(setq mecLineLength
(strcat
(rtos
(+ (fix
(/ (vlax-get-property mecSelLine 'Length) 12)
)
1
)
2
0
)
"' APPROX."
)
)
(setq mecLineLayer (vlax-get-property mecSelLine 'Layer))
(setq mecLineAngle
(/ (* 180.0 (vlax-get-property mecSelLine 'Angle)) PI)
)
(setq mecGetPoint
(getpoint "\nSelect location for distance label: ")
)
(command "-layer" "s" mecLineLayer "")
(command "text" mecGetPoint mecTxtSize mecLineAngle mecLineLength)
;;;;; I'd like to remove this section
(initget 1 "Y N")
(setq mecYN (getkword "\nRotate text <Y>es or <N>o: "))
(setq mecAnswer
(cond
((= mecYN "Y") 2)
((= mecYN "N") 4)
)
;;end cond
)
(if (= mecAnswer 2)
(progn
(command "rotate" "l" "" mecGetPoint "180")
(setvar 'cmdecho cmd)
(setvar 'osmode osm)
(setvar 'clayer mecGetLayer)
)
;;end progn
)
;;end if
(if (= mecAnswer 4)
(progn
(setvar 'cmdecho cmd)
(setvar 'osmode osm)
(setvar 'clayer mecGetLayer)
)
;;end progn
)
;;end if
;;;;; I'd like to remove section above
(setq mecSelLine
(vlax-ename->vla-object
(car (entsel "\nSelect conduit line to label: "))
)
)
)
;;end while
(princ)
)
--- End code ---
the thing is, if a line is drawn from left to right it's shown as one angle. If it's drawn for right to left it shows another angle
Kerry:
See what you can get from this ..
Some of the routines are from my library, but you should grt the idea ..
The Text:rotation and InsertPoint are the one you want, I think.
.. and Rad90 and Rad270 are constants I use.
--- Code: ---
(defun c:LengthOnLine (/ L1 L1:ANG
L1:EPT L1:LEN L1:MIDPT
L1:NAME L1:SPT ORD1
ORD2 T1:INSERTIONPOINT
T1:MTEXTOBJ T1:ROTATION T1:TEXTHEIGHT
T1:TEXTSTRING
)
(setq l1 (vlax-ename->vla-object (car (kbsf:entsel "Select LINE Object"
nil
nil
(list "LINE")
t
t
)
)
)
l1:len (vla-get-length l1)
l1:spt (vlax-get l1 'startpoint)
l1:ept (vlax-get l1 'endpoint)
l1:ang (vlax-get l1 'angle) ; 0.282605
l1:midpt (mapcar '(lambda (ord1 ord2) (* (+ ord1 ord2) 0.5))
l1:spt
l1:ept
)
;;
;;
t1:textstring (rtos l1:len)
t1:textheight (* (getvar "DIMTXT") (getvar "DIMscale"))
t1:rotation (if (and (> l1:ang rad90) (<= l1:ang rad270))
(- l1:ang pi)
l1:ang
)
t1:insertionpoint (polar l1:midpt
(+ t1:rotation rad90)
(* 0.333 t1:textheight)
)
t1:mtextobj (vla-addmtext kbsg:modelspace
(vlax-3d-point t1:insertionpoint)
0.0
t1:textstring
)
)
(vla-put-layer t1:mtextobj "DIMS")
(vla-put-height t1:mtextobj t1:textheight)
(vla-put-attachmentpoint t1:mtextobj acattachmentpointbottomcenter)
(vla-put-insertionpoint t1:mtextobj
(vlax-3d-point t1:insertionpoint)
)
(vla-put-rotation t1:mtextobj t1:rotation)
)
--- End code ---
Craig:
Thanks Kerry, I got what I needed out of it. Very simple once I see it. :lol:
It works perfect which puts me at 90% completion on this program
Thanks :D
Navigation
[0] Message Index
Go to full version