TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: CAB on September 04, 2007, 02:48:06 PM
-
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.
;;;===================[ 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)
)
)
)
;;------------------------------------------------------------
<edit: updated code>
-
Se ve bien, Maestro! :)
-
Thank you kind sir. 8-)
-
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..... :)
-
Yes, my standard detail.
I added this
;; correct p3 to maintain a horizontal line
(setq p3 (list (car p3) (cadr p2)))
-
Alan
I like you routine...
Here is what I use (options include making it a block or a group for the final bubble).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Block or Group Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:BLOCK-GROUP (/ yn)
(defun ARCH_BLOCK ()
(command
"-block"
(princ ARCH#_NIC)
(getvar "lastpoint")
(princ ARCH#SSET)
"")
(command "-insert" (princ ARCH#_NIC) (getvar "lastpoint") "" "" ""))
(defun ARCH_GROUP ()
(setq ARCH#_NIC "*")
;;anon group
(command "-group" "" (princ ARCH#_NIC) "" (princ ARCH#SSET) ""))
(initget "B G")
(setq yn
(getkword
"\n* Select Creation Type <default is group>: <B>lock <G>roup <enter> for group*"))
(cond ((= yn "B") (ARCH_BLOCK))
((or (/= yn "B") (= yn "G")) (ARCH_GROUP)))
(setq ARCH#_NIC nil
ARCH#SSET nil)
(princ))
;;;
(defun ARCH:BLOCK- ()
(command
"-block"
(princ ARCH#_NIC)
(getvar "lastpoint")
(princ ARCH#SSET)
"")
(command "-insert" (princ ARCH#_NIC) (getvar "lastpoint") "" "" "")
(setq ARCH#_NIC nil
ARCH#SSET nil)
(princ))
;;;
(defun ARCH:GROUP- ()
(setq ARCH#_NIC "*")
;;anon group
(command "-group" "" (princ ARCH#_NIC) "" (princ ARCH#SSET) "")
(setq ARCH#_NIC nil
ARCH#SSET nil)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;; Raddom Generator Number ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:RAND*NO ()
(setq *NO (rtos (getvar "CDATE") 2 16)
*NO (substr *NO 14 3)
;;3
)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Detail Bubble ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:RPD (/ efat efsht ltag angx *NO SB pdend pdend2 scf pdtx pd1 pdtx angt pickdir
ango pdend ptb1 ptb2 ptb3 ptb4 rad)
(if (= ARCH#BLKX nil)
(ARCH:BLKNAM "SYMBUB" (strcat ARCH#CUSF "SYMS/")))
(setq scf (getvar "dimscale"))
;(ARCH:CUSTOM_LAYERS-SYMB) my custom layer creator
(setq ARCH#SSET (ssadd))
(setq rad (* 0.375 (getvar "dimscale")))
;;(setvar "PLINEWID" (* (getvar "dimscale") 0.0125))
;;0.015625
(setq efat (getstring t (strcat "\n* Enter the Reference Number <" ARCH#DTLN ">:")))
(setq efsht (getstring t (strcat "\n* Enter the Sheet Number <" ARCH#SHTN ">:")))
(cond ((/= efat "") (setq ARCH#DTLN efat))
((= efat "") (setq efat ARCH#DTLN)))
(cond ((/= efsht "") (setq ARCH#SHTN efsht))
((= efsht "") (setq efsht ARCH#SHTN)))
(setvar "osmode" 0)
(setq ptb1 (getpoint "\n* Pick upper left hand corner point *"))
(setq ptb3 (getcorner "\n* Pick opposite corner point *" ptb1))
(setq ptb2 (list (car ptb1) (cadr ptb3)))
(setq ptb4 (list (car ptb3) (cadr ptb1)))
(command "pline" ptb1 ptb2 ptb3 ptb4 "c")
(setq ARCH#SSET (ssadd (entlast) ARCH#SSET))
(command "fillet" "r" rad "")
(command "fillet" "p" "l")
(command "change" "last" "" "properties" "lt" "HIDDEN" "c" "2" "")
(setvar "orthomode" 0)
(setvar "osmode" 512)
(setq pd1 (getpoint "\n* Pick along BUBBLE ... for the text location *"))
(setq pdtx (getpoint pd1 "\n* To Point *"))
(setq angt (angle pd1 pdtx))
(setvar "orthomode" 1)
(setq pickdir (getpoint pdtx "\n* Pick Direction *"))
(setq ango (angle pdtx pickdir))
(setq pdend (polar pdtx ango (* 0.25 (getvar "dimscale"))))
(setvar "osmode" 0)
(command "PLINE" pd1 pdtx pdend "")
(command "change" "last" "" "properties" "c" "2" "")
(setq ARCH#SSET (ssadd (entlast) ARCH#SSET))
(setvar "cmdecho" 0)
(command
"insert"
(strcat ARCH#CUSF "SYMS/" "SYMBUB")
"ps"
SCF
(getvar "lastpoint")
SCF
""
""
efat
(strcase efsht))
(setq ARCH#SSET (ssadd (entlast) ARCH#SSET))
(setq pdend (polar pdtx ango (* 0.5 SCF)))
(command "PLINE" (getvar "lastpoint") pdend "")
(command "change" "last" "" "properties" "c" "2" "")
(setq ARCH#SSET (ssadd (entlast) ARCH#SSET))
(ARCH:RAND*NO)
(setq ARCH#_NIC (strcat "SYMRPD-" *NO))
(ARCH:BLOCK-GROUP)
(command "fillet" "r" "0")
(prompt "\n* Detail Rectangular Bubble Mark completed *"))
Gary
-
Nice one Gary.
Thanks for sharing.
-
Probably so will be more correct
(setq p1 (getpoint (strcat "\nPick corner away from tag or [Textsize/Plinewidth]:TH->"
(rtos *MyTextsize 2 2) " Plw->"(rtos *MyPLWidth 2 2))))
Text [Textsize/Plinewidth]
instead [Textsize\Plinewidth]
-
I often forget which slash is needed to enable the choices in the right click menu.
I think that's because I never use the right click feature. 8-)
-
Had some spare time so I added a twist to the pick point routine.
Code updated in the first post.
Also I removed the fillet for now.
<edit: added fillets back in>