; DH.LSP   [Article Figure 1]   (c)1990, Barry Bowen

; ***************************** DH.LSP ************************
; Copyright (c) Barry R. Bowen 1990
; -------------------------------------------------------------
; TOOLBOX ROUTINES USED:
; *ERROR*                    Error Handling routine (Sept '89)
; (E1), (E2), (E3), (E4)   Entity handling routines (Sept '89)
; (LS), (RL)         Routines for automatic layering (Feb '90)
; (V1), (V1R)               System Variable routines (Feb '89)
; (V3), (V4)            Start-up and Ending routines (Feb '89)
; -------------------------------------------------------------
; Variables:
; ANG    = Angle used for second dimension string location
; ANS    = Used for Prompts
; ACDIST = User typed distance string
; BPT    = Base point for second dimension string
; DB1    = Original setting of dimblk1
; DB2    = Original setting of dimblk2
; DIST   = Actual dimension distance from PT1 to PT2
; DIMREP = Number of dimension strings
; MPT    = Center text insert point for dimension strings
; PT1    = First ext. line location
; PT1A   = Second ext. line location
; SS1    = Selection-set of all blocks named NONE
;
; Sample Call:
;  For horizontal dimensions
   (defun C:DH () (AUTODIM "HORIZ" 0 1.5708))
;
;  For Vertical dimensions
   (defun C:DV () (AUTODIM "VERT" 1.5708 3.14159))

; ---------------------- DH.LSP -------------------------------
 (defun AUTODIM (DIREC ANG1 ANG2 / ANG BPT PT1 PT1A PT1C    ; 1
                 PT2 PT3 DIMREP ANS ACDIST DIST DB1 DB2)    ; 2
  (V3)                                                      ; 3
  (prompt "\nSetting The Environment....")                  ; 4
  (V1 '("dimse1" "dimse2" "dimtsz" "dimsah" "dimaso"        ; 5
        "flatland" "orthomode" "snapmode" "osmode"))        ; 6
  (setq DB1 (getvar "dimblk1")                              ; 7
        DB2 (getvar "dimblk2")                              ; 8
     DIMREP 0)    ;End SetQ line 7                          ; 9
  (foreach N '("dimsah" "flatland" "orthomode" "dimtsz")    ;10
              (setvar N 1))                                 ;11
  (foreach N '("dimse1" "dimse2" "dimtsz" "dimaso"          ;12
               "osmode") (setvar N 0))                      ;13
  (if (not (tblsearch "block" "NONE"))                      ;14
    (progn                                                  ;15
      (command "insert" "NONE" "0,0" "" "" "")              ;16
      (entdel (entlast))) ;End Progn line 15                ;17
  )                       ;end If line 14                   ;18
  (if (not (tblsearch "block" "ticknew"))                   ;19
    (progn                                                  ;20
      (command "insert" "ticknew" "0,0" "" "" "")           ;21
      (entdel (entlast))) ;End Progn line 20                ;22
  )                       ;End If line 19                   ;23
  (command "dim" "dimblk1" "ticknew" "dimblk2" "ticknew"    ;24
           "exit")                                          ;25
  (LS "DIM" "5" "")                                         ;26
  (initget (+ 2 4))                                         ;27
  (setq DIMREP (getint "\nNumber of Strings <1>: "))        ;28
  (if (not DIMREP) (setq DIMREP 1))                         ;29
  (setq DIMREP (1- DIMREP)                                  ;30
        PT1 (getpoint                                       ;31
        "\nFirst Ext Line Origin <Return to Select>: "))    ;32
  (if (not PT1) (GLINE)                                     ;33
      (progn                                                ;34
        (setq BPT PT1)                                      ;35
        (initget 1)                                         ;36
        (setq PT1A (getpoint "\nSecond Ext Line Origin: ")  ;37
              PT1C PT1A)                                    ;38
        (SUP1)                                              ;49
        (SUP2)                                              ;41
        (PLOCATE)   ;Locate points with Int                 ;42
  )   )             ;End Progn line 34, If line 33          ;43
  (initget 1)                                               ;44
  (setq PT3 (getpoint "\nDimension Line Location: "))       ;45
  (DIMSTR)                                                  ;46
  (command "undo" "group" "dim" DIREC PT1 PT1A PT3 "."      ;47
           "dimse1" "on" "exit")                            ;48
  (NEWSTRING)                                               ;49
  (RLOC)                                                    ;50
; ---------- Begin Second Dimensioning String -----------------
  (repeat DIMREP                                            ;51
    (setq pt4 (getpoint                                     ;52
         "\nNext Dimension String Location <Standard>: "))  ;53
    (if (not pt4) (progn (P3LOCATE) (NEWLINE))              ;54
                  (setq PT3 PT4))                           ;55
    (initget 1)                                             ;56
    (setq PT1C (getpoint "\nSecond Ext Line Origin: "))     ;57
    (SUP2)                                                  ;58
    (PLOCATE)                                               ;59
    (DIMSTR)                                                ;60
    (command "undo" "group" "dim" DIREC PT1 PT1C PT3 "."    ;61
             "dimblk1" "NONE" "exit")                       ;62
    (NEWSTRING)                                             ;63
    (RLOC)                                                  ;64
    (while PT2                                              ;65
      (setq PT1 PT2 PT1C (getpoint                          ;66
                 "\nSecond Ext Line Origin <Return>: "))    ;67
      (if (/= PT1C nil)                                     ;68
        (progn                                              ;69
          (setq ANS (getstring                              ;70
                   "\nSuppress Second Ext. Line? <N>: "))   ;71
          (if (/= ANS "")                                   ;72
              (command "dim" "dimse2" "on" "exit"))         ;73
          (PLOCATE)                                         ;74
          (DIMSTR)                                          ;75
          (command "undo" "group" "dim" "contin" PT1C "."   ;76
                   "dimse2" "off" "exit")                   ;77
          (NEWSTRING)                                       ;78
          (RLOC)                                            ;79
        )             ;End Progn line 69                    ;80
        (progn                                              ;81
         (setq ANS (getstring "\nComplete String <Y>: "))   ;82
         (if (= ANS "")                                     ;83
          (progn                                            ;84
            (setvar "dimse2" 1)                             ;85
            (setq PT1 PT2                                   ;86
                  PT1B (polar PT1 ANG1 1)                   ;87
                  PT2A (polar PT1A ANG2 1)                  ;88
                   PT2 (inters PT1 PT1B PT1A PT2A nil))     ;89
            (DIMSTR)                                        ;90
            (command "undo" "group" "dim" "contin" PT1A     ;91
                     "." "dimblk1" "ticknew" "exit")        ;92
            (NEWSTRING)                                     ;93
            (RLOC)                                          ;94
            (setq PT2 nil PT1 BPT)                          ;95
          )           ;End Progn line 84                    ;96
          (progn                                            ;97
            (setq PT2 nil PT1 BPT)                          ;98
            (command "dim1" "dimblk1" "ticknew")            ;99
         ))         ;End Progn line 97, If line 83         ;100
      ) )           ;End Progn line 81, If line 68         ;101
    )               ;End While line 65                     ;102
  )                 ;End DIMREP repeat line 51             ;103
  (command "dim" "dimblk1" DB1 "dimblk2" DB2 "exit")       ;104
  (setq SS1 (ssget "x" '((2 . "NONE"))))                   ;105
  (command "erase" SS1 "")                                 ;106
  (foreach N '(PT4 PT1B PT2A PT1G PT13 ANG1 ANG2 MPT SS1)  ;107
              (setq N nil))                                ;108
  (RL)              ;Reset original layer                  ;109
  (V4)              ;Ending routine                        ;110
)                   ;End DeFun                             ;111