Topic: 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: [Select]

;;;===================[ 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>

[LE]

Se ve bien, Maestro! 

[CAB]

Thank you kind sir.

[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: [Select]

  ;;  correct p3 to maintain a horizontal line
  (setq p3 (list (car p3) (cadr p2)))

[GDF]

Alan

I like you routine...
Here is what I use (options include making it a block or a group for the final bubble).

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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

[CAB]

Nice one Gary.
Thanks for sharing.

[VVA]

Probably so will be more correct

Code: [Select]

(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]

[CAB]

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.

[CAB]

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>