what's wwrong with this please

Discussion in 'AutoCAD' started by chuck, Jan 21, 2004.

  1. chuck

    chuck Guest

    This lisp routine was downloaded from the internet. I've modified it
    from it's original version. AA applies aligned dimensions substituting
    custom character codes for the autocad dimension text. Likewise VV for
    vertical and HH for horizontal. ED edits dimension text. All works
    except RR for radial dimensions. What am I doing wrong. Thanks for any
    help.

    ;AA FOR ALIGNED
    ;HH FOR HORIZONTAL
    ;VV FOR VERTICAL
    ;RR FOR RADIAL
    ;compliments of Tim Quinn

    (defun rtd (a) (* 180.0 (/ a pi)))
    (defun TXTFR (QDIM / TFR TFT TFR1 COUNT XXX QDIMX HOWLEN QDIMQ)
    (setvar "cmdecho" 0)
    (setq COUNT 1
    XXX nil
    QDIMQ (rtos QDIM 4 4)
    HOWLEN (strlen QDIMQ)
    QDIMX nil
    )
    (while (/= HOWLEN COUNT)
    (if (= " " (substr QDIMQ COUNT 1))
    (setq XXX COUNT)
    )
    (setq COUNT (+ 1 COUNT))
    )
    (cond ((= XXX nil) (setq TFR1 QDIMQ)))
    (cond ((= XXX nil) (setq TFT "")))
    (cond ((/= XXX nil) (setq TFR1 (substr QDIMQ (+ 1 XXX)))))
    (cond ((/= XXX nil) (setq TFT (substr QDIMQ 1 (- XXX 1)))))

    ;CHANGE THESE LINES FOR YOUR ASCII CODES
    ;REPLACE NUMBER AFTER THE chr

    (cond ((= TFR1 (rtos 0.9375)) (setq TFR (chr 145))) ;15;16
    ((= TFR1 (rtos 0.875)) (setq TFR (chr 144))) ;7;8
    ((= TFR1 (rtos 0.8125)) (setq TFR (chr 143))) ;13;16
    ((= TFR1 (rtos 0.75)) (setq TFR (chr 142))) ;3;4
    ((= TFR1 (rtos 0.6875)) (setq TFR (chr 141))) ;11;16
    ((= TFR1 (rtos 0.625)) (setq TFR (chr 140))) ;5;8
    ((= TFR1 (rtos 0.5625)) (setq TFR (chr 139))) ;9;16
    ((= TFR1 (rtos 0.5)) (setq TFR (chr 138))) ;1;2
    ((= TFR1 (rtos 0.4375)) (setq TFR (chr 137))) ;7;16
    ((= TFR1 (rtos 0.375)) (setq TFR (chr 136))) ;3;8
    ((= TFR1 (rtos 0.3125)) (setq TFR (chr 135))) ;5;16
    ((= TFR1 (rtos 0.25)) (setq TFR (chr 134))) ;1;4
    ((= TFR1 (rtos 0.1875)) (setq TFR (chr 133))) ;3;16
    ((= TFR1 (rtos 0.125)) (setq TFR (chr 132))) ;1;8
    ((= TFR1 (rtos 0.0625)) (setq TFR (chr 131))) ;1;16
    )
    (cond ((= TFR nil) (setq TFR (substr QDIMQ 1 (- HOWLEN 1)))))
    (strcat TFT TFR)
    )

    (defun C:ED ()
    (graphscr)
    (setq QDIMX (getstring "\nEnter new dimension text "))
    (setvar "OSMODE" 0)
    (command "dimedit"
    "new"
    (txtfr (distof QDIMX 3))
    )
    )


    (defun C:AA (/ TT6 TT3 TT2 TT1 OSMO)
    (graphscr)
    (setvar "cmdecho" 0)
    (setq OSMO (getvar "OSMODE"))
    (setq TT1 (getpoint "\nPick first point: ")
    TT2 (getpoint "\nPick second point: ")
    )
    (command "dimaligned" TT1 TT2 pause "" "")
    (command "erase" "last" "")
    (setq TT3 (getvar "lastpoint")
    DLFAC (getvar "dimlfac")
    TT6 (* dlfac (distance TT1 TT2))
    QDIM (rtos TT6 4 4)
    QDIMX nil
    )
    (princ "\nDimension text <")
    (princ QDIM)
    (princ ">")
    (setq QDIMX (getstring T ": ")
    )
    (setvar "OSMODE" 0)
    (if (= QDIMX "")
    (command "dim" "ali" TT1 TT2 TT3 (txtfr TT6) ^c)
    (command "dim"
    "ali"
    TT1
    TT2
    TT3
    (txtfr (distof QDIMX 3))
    ^c
    )
    )
    (setvar "OSMODE" OSMO)
    (princ)
    )



    (defun C:HH (/ TT6 TT5 TT4 TT3 TT2 TT1 OSMO)
    (graphscr)
    (setvar "cmdecho" 0)
    (setq OSMO (getvar "OSMODE"))
    (setq TT1 (getpoint "\nPick first point: ")
    TT2 (getpoint "\nPick second point: ")
    )
    (command "dimhorizontal" TT1 TT2 pause "" "")
    (command "erase" "last" "")
    (setq TT3 (getvar "lastpoint")
    TT4 (list (car TT1) (cadr TT3))
    TT5 (list (car TT2) (cadr TT3))
    DLFAC (getvar "dimlfac")
    TT6 (* dlfac (distance TT4 TT5))
    QDIM (rtos TT6 4 4)
    QDIMX nil
    )
    (princ "\nDimension text <")
    (princ QDIM)
    (princ ">")
    (setq QDIMX (getstring T ": "))
    (setvar "OSMODE" 0)
    (if (= QDIMX "")
    (command "dim" "hor" TT1 TT2 TT3 (txtfr TT6) ^c)
    (command "dim"
    "hor"
    TT1
    TT2
    TT3
    (txtfr (distof QDIMX 3))
    ^c
    )
    )
    (setvar "OSMODE" OSMO)
    (princ)
    )



    (defun C:VV (/ TT6 TT5 TT4 TT3 TT2 TT1 OSMO)
    (graphscr)
    (setvar "cmdecho" 0)
    (setq OSMO (getvar "OSMODE"))
    (setq TT1 (getpoint "\nPick first point: ")
    TT2 (getpoint "\nPick second point: ")
    )
    (command "dimvertical" TT1 TT2 pause "" "")
    (command "erase" "last" "")
    (setq TT3 (getvar "lastpoint")
    TT4 (list (cadr TT1) (car TT3))
    TT5 (list (cadr TT2) (car TT3))
    DLFAC (getvar "dimlfac")
    TT6 (* dlfac (distance TT4 TT5))
    QDIM (rtos TT6 4 4)
    QDIMX nil
    )
    (princ "\nDimension text <")
    (princ QDIM)
    (princ ">")
    (setq QDIMX (getstring T ": "))
    (setvar "OSMODE" 0)
    (if (= QDIMX "")
    (command "dim" "ver" TT1 TT2 TT3 (txtfr TT6) ^c)
    (command "dim"
    "ver"
    TT1
    TT2
    TT3
    (txtfr (distof QDIMX 3))
    ^c
    )
    )
    (setvar "OSMODE" OSMO)
    (princ)
    )

    (defun C:RR ()
    (graphscr)
    (setvar "cmdecho" 0)
    (setq OSMO (getvar "OSMODE"))
    (setq ent (entsel "select circle or arc to dimension"))
    (command "dimradius" ent "")
    (command "erase" "last" "")
    (setq entl (entget (entlast)))
    (setq TT5 (cdr (assoc 42 entl)))
    (setq DLFAC (getvar "dimlfac")
    TT6 (* dlfac TT5)
    QDIM (rtos TT6 4 4)
    QDIMX nil
    )
    (princ "\nDimension text <")
    (princ QDIM)
    (princ ">")
    (setq QDIMX (getstring T ": "))
    (setvar "OSMODE" 0)
    (if (= QDIMX "")
    (command "dim" "radius" ent pause (txtfr TT6) ^c)
    (command "dim" "radius" ent pause (distof QDIMX 3) ^c)
    )
    (setvar "OSMODE" OSMO)
    (princ)
    )
     
    chuck, Jan 21, 2004
    #1
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.