Code Red > AutoLISP (Vanilla / Visual)

Detail Indicator Tool

<< < (2/2)

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: ---;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 *"))

--- End code ---

Gary

CAB:
Nice one Gary.
Thanks for sharing.

VVA:
Probably so will be more correct

--- Code: ---(setq p1 (getpoint (strcat "\nPick corner away from tag or [Textsize/Plinewidth]:TH->"
                                 (rtos *MyTextsize 2 2) " Plw->"(rtos *MyPLWidth 2 2))))
--- End code ---
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. 8-)

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>

Navigation

[0] Message Index

[*] Previous page