Code Red > AutoLISP (Vanilla / Visual)
Detail Indicator Tool
CAB:
Although still in development here is my latest play toy. :-)
The purpose is to draw the detail indicator as shown in the picture.
Comments & suggestions welcome.
--- Code: ---;;;===================[ DetailRectangle.lsp ]===================
;;; Author: CAB @ TheSwamp.org
;;; Version: 1.5 Sep 21 2007
;;; Note: uses current layer at this time
;;; Purpose: To draw a rectangle around area to be detailed
;;; and provide a attribute for Detal # and Sheet #
;;; attribute block scale is based on the current text height
;;;=============================================================
;; You may set the text Height or the Pline Width at the first prompt.
;; text height can be set before the first point is picked by pressing T
;; radius of the pline rectangle is based on the diaganal
;; distance of the rectangle
;; No error correction for missed pick of point p3
;; No error correction for too large a text height for the rectangle picked
(defun c:DetailR (/ ang ent idx p1 p2 p3 plst rad refpts sysattdia sysattreq
sysplwid systxteva tmp usrf msg newpts *error*)
(vl-load-com)
;; error function & Routine Exit
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; endif
;;reset all variables here
(and sysattdia (setvar "ATTDIA" sysattdia))
(and sysattreq (setvar "ATTREQ" sysattreq))
(and systxteva (setvar "TEXTEVAL" systxteva))
(if (and ent (/= msg "")) (entdel ent))
(setq sysattdia nil
sysattreq nil
systxteva nil
ent nil)
(redraw)
) ;end error function
(or *MyTextsize (setq *MyTextsize (getvar "textsize"))) ; default size
(or *MyPLWidth (setq *MyPLWidth 0.0)) ; default PL Width
(setq msg "")
;; ============== Get User Input ==================
;; get Text size or point
(while
(progn
(initget 1 "Textsize Plinewidth") ; prevent ENTER but allow a KeyWord
(setq p1 (getpoint (strcat "\nPick corner of rectangle or [Textsize/Plinewidth]:Ts->"
(rtos *MyTextsize 2 2) " Plw->"(rtos *MyPLWidth 2 2))))
(cond
((= p1 "Textsize")
(initget 6) ; no error checking
(setq tmp (getdist (strcat "\nEnter new text height: <" (rtos *MyTextsize 2 2) "> ")))
(and tmp (setq *MyTextsize tmp))
t ; stay in loop
)
((= p1 "Plinewidth")
(initget 4) ; no error checking
(setq tmp (getdist (strcat "\nEnter new Pline Width: <" (rtos *MyPLWidth 2 2) "> ")))
(and tmp (setq *MyPLWidth tmp))
t ; stay in loop
)
(t nil) ; point entered, exit loop
) ; end cond stmt
)
) ; while
(initget 1)
(setq p2 (getcorner p1 "\nPick opposite corner of rectangle."))
;; Draw a rectangle
(setq sysplwid (getvar "plinewid"))
(setvar "plinewid" *MyPLWidth)
(command "._pline"
"_non" p2
"_non" (list (car p2) (cadr p1)) "_non" p1 "_non"
(list (car p1) (cadr p2)) "_c")
(setq ent (entlast))
;; get attachment points
(setq idx 4.)
(while (>= (setq idx (- idx 0.5)) 0)
(setq refpts (cons (vlax-curve-getPointAtParam ent idx) refpts))
)
;; ================ Create the Polyline =============
(setq rad (* (distance p1 p2) 0.05))
(setq usrf (getvar "filletrad"))
(setvar "filletrad" rad)
(command "._fillet" "_P" ent)
(setvar "filletrad" usrf)
;; get points around filleted pline
(mapcar
'(lambda(p) ; points in WCS
(setq newpts (cons (vlax-curve-getClosestPointTo ent p) newpts)))
refpts
)
(setq refpts newpts)
(prompt "\nPick end of Tag Line.")
(if (and (setq plst (getpt refpts *MyTextsize))
(setq plst (getpt plst *MyTextsize)))
(progn
;; draw leader
(command "_.pline" "_non" (car plst) "_non" (cadr plst) "_non" (caddr plst) "")
(setvar "plinewid" sysplwid)
(setq ang (angle (cadr plst) (caddr plst)))
(if (equal ang pi 0.001 )
(setq p3 (polar (caddr plst) pi (* *MyTextsize 2.58)))
(setq p3 (polar (caddr plst) 0 (* *MyTextsize 2.58)))
)
;; add block to DWG
(or (tblsearch "Block" "Detail-Sheet-01") (eMake))
;; Insert Attr block & get attribute values from user
(setq sysattdia (getvar "ATTDIA"))
(setq sysattreq (getvar "ATTREQ"))
(setq systxteva (getvar "TEXTEVAL"))
(setvar "ATTDIA" 1)
(setvar "ATTREQ" 0)
(setvar "TEXTEVAL" 0)
(if (tblsearch "block" "Detail-Sheet-01")
(progn
(command "._-insert" "Detail-Sheet-01" "_non" p3 *MyTextsize "" "")
(initdia 1) ; get the attrubute values from the user
(command "._attedit" (entlast))
)
)
)
(setq msg "User Quit")
)
(*error* msg) ; call error routine to reset vars
(princ) ; exit quietly
)
;; Make the Attrubute Block
;; Revision :09/02/2007 @15:57
(defun eMake ()
(entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference")
(66 . 1) (2 . "Detail-Sheet-01") (10 0.0 0.0 0.0) (70 . 2)))
(entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 0) (6 . "ByBlock")
(380 . 1) (100 . "AcDbText") (10 -0.000000000000114 0.250000000000057 0.00)
(40 . 1.0) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0)
(72 . 1) (11 -0.000000000000114 0.250000000000057 0.00)
(100 . "AcDbAttributeDefinition") (3 . "Detail-Number") (2 . "DETAIL")
(70 . 0) (73 . 0) (74 . 0)))
(entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 0) (6 . "ByBlock")
(380 . 1) (100 . "AcDbText") (10 -0.000000000000114 -1.25 0.0) (40 . 1.0)
(1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 1)
(11 -0.000000000000114 -0.25 0.0) (100 . "AcDbAttributeDefinition")
(3 . "Sheet-Number") (2 . "SHEET") (70 . 0) (73 . 0) (74 . 3)))
(entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline")
(90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
(10 -2.478351712299855 -1.921005216799813) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 2.478351712299741 -1.921005216799813) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 2.478351712299741 1.921005216799756) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 -2.478351712299855 1.921005216799756) (40 . 0.0) (41 . 0.0) (42 . 0.0)))
(entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline")
(90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
(10 -2.581203712299839 -2.023857216799684) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 2.581203712299612 -2.023857216799684) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 2.581203712299612 2.023857216799684) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 -2.581203712299839 2.023857216799684) (40 . 0.0) (41 . 0.0) (42 . 0.0)))
(entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
) ; end eMaker
(prompt "\nDetail Rectangle Loaded, Enter DetailR to run.")
(princ)
;;------------------------------------------------------------
;; draw leader while user picks point
(defun getpt (plst th / done grr typ key vecs)
(princ "\nPick Point or Enter for none.")
(while
(progn
(setq grr (grread 't 4 1)
typ (car grr)
key (cadr grr)
)
(if vecs (grvecs vecs)) ; draw vectors
(cond
((= typ 2) ; if keyboard
(if (or (= key 13) (= key 32)) ; Enter or Space Bar
(setq key nil)
t
)
)
((= typ 3) nil) ; point picked
((= typ 5) (grvecs (setq vecs (calcvecs key plst th))) t) ; mouse
)
)
)
(if (= typ 3)
(list (cadr vecs) (caddr vecs) (nth 4 vecs)) ; 3 point list
)
)
;; Calculate leader vectors
(defun calcvecs (pt plst txtht / ap ang p1 p2 p3 p4 p5)
;; pt is the user cursor point
;; txtht is the text height
;; plst is a point list of corners & step points around the rectangle
(if (> (length plst) 3)
(progn
;; find the closet point in the plst to pt
;; ap = the closest point when done. Anchor Point
(mapcar
'(lambda (x)
(cond
((null ap) (setq ap x))
((< (distance pt x) (distance pt ap))
(setq ap x)
)
)
)
plst
)
;; create the vectors
(setq ang (angle pt ap))
(if (and (> ang 1.5708) (< ang 4.71239))
;; ang between 90 and 270
(setq p1 (polar pt 0 txtht)
p2 (polar p1 (/ pi 2) (* txtht 2))
p3 (polar p2 0 (* txtht 6))
p4 (polar p3 (* pi 1.5) (* txtht 4))
p5 (polar p4 pi (* txtht 6))
)
(setq p1 (polar pt pi txtht) ; left
p2 (polar p1 (/ pi 2) (* txtht 2)) ; up
p3 (polar p2 pi (* txtht 6)) ; right
p4 (polar p3 (* pi 1.5) (* txtht 4)) ; down
p5 (polar p4 0 (* txtht 6)) ; left
)
)
(list 257 ap pt pt p1 p1 p2 p2 p3 p3 p4 p4 p5 p5 p1)
)
(progn ; 3 point list, drag to get horz pt
;; create the vectors
(setq ap (car plst)
p1 pt
pt (cadr plst)
p1 (list (car p1) (cadr pt) (caddr p1)) ; fix the y direction
)
(setq ang (angle pt ap))
(if (and (> ang 1.5708) (< ang 4.71239))
;; ang between 90 and 270
(setq p2 (polar p1 (/ pi 2) (* txtht 2))
p3 (polar p2 0 (* txtht 6))
p4 (polar p3 (* pi 1.5) (* txtht 4))
p5 (polar p4 pi (* txtht 6))
)
(setq p2 (polar p1 (/ pi 2) (* txtht 2)) ; up
p3 (polar p2 pi (* txtht 6)) ; right
p4 (polar p3 (* pi 1.5) (* txtht 4)) ; down
p5 (polar p4 0 (* txtht 6)) ; left
)
)
(list 257 ap pt pt p1 p1 p2 p2 p3 p3 p4 p4 p5 p5 p1)
)
)
)
;;------------------------------------------------------------
--- End code ---
<edit: updated code>
LE:
Se ve bien, Maestro! :)
CAB:
Thank you kind sir. 8-)
LE:
I see, that the leg or the block line location, must always needs to be drawn horizontal and to make sure to draw it to the outside corner of the rectangle area.....
I know this is part of your own standard symbols..... :)
CAB:
Yes, my standard detail.
I added this
--- Code: --- ;; correct p3 to maintain a horizontal line
(setq p3 (list (car p3) (cadr p2)))
--- End code ---
Navigation
[0] Message Index
[#] Next page
Go to full version