Author Topic: Angles again.  (Read 6127 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Angles again.
« Reply #15 on: October 18, 2004, 05:38:01 PM »
rugaroo,
 
 Here are some more changes I would make, hope you don't mind.
 
Code: [Select]
;;;-------------------------------------------------------------;;;
;;;           CNOTES.lsp - Created by: Roland W. Frye           ;;;
;;;           Version: V.1.0-NG Released: 2004.10.20            ;;;
;;;               For Support Information visit:                ;;;
;;;            http://www.civildraftingservices.com             ;;;
;;;-------------------------------------------------------------;;;

(defun c:const (/ cmd fil lts cla ans cnot pnt1 pnt2 val:multiplier)
  ;;  CAB - new subroutine
  (defun put_note (pnt pnt1 pnt2 cnot)
    (command "leader" pnt1 pnt2 "" "" "none") ; End Command - Leader
    (command ".-insert" "cnote" "s" (getvar "ltscale")
             (polar pnt2 (angle pnt1 pnt2) pnt) (getvar "snapang") cnot
    ) ; End command - note insert
  )

  (setq cmd (getvar "cmdecho")
        fil (getvar "filedia")
        lts (getvar "ltscale")
        snp (getvar "snapang")
        cla (getvar "clayer")
  ) ; End Setq
  (setvar "cmdecho" 0)
  (setvar "filedia" 0)
  (initget 1 "Circle Ellipse Square Hexagon Triangle")
  (setq ans
         (getkword
           "\nConstruction note type - <Circle/Ellipse/Square/Hexagon/Triangle>: "
         )
  )
  ;;  CAB - because you start with leader get points in all choices
  ;;  do it only once, moved code here
  ;;(setvar "blipmode" 1) ; CAB - eleminated blipmode in favor of
  ;;  using a line in the second getpoint
  ;;  used the (and to test for all the needed info befor proceeding
  (if (and
        (setq pnt1 (getpoint "\nStarting point of leader:"))
        (setq pnt2 (getpoint pnt1 "\nEnding point of leader:"))
      ) ; End And
    (progn ; got needed info
      (initget (+ 1 2 4))
      (setq cnot (getint "\nConstruction note number:"))
      (if (tblsearch "layer" "P-CNOTE-T") ; revised CAB
        (command "layer" "S" "P-CNOTE-T" "")
        (command "layer" "m" "P-CNOTE-T" "C" "7" "" "")
      ) ; End if
      ;;===============================================================

      ;;======================================================
      ;;  because only one answer use a (cond instead of (if
      (cond
        ;;----------------
        ((= ans "Circle")
         ;; CAB - because the 'leader' & 'insert' code is the sane make it a subroutine
         (put_note (* 0.09 lts) pnt1 pnt2 cnot)
         ;;  CAB - because your exit sequence is always the same
         ;;  moved the code to the end of the routine
        ) ; end cond "Circle"

        ;;----------------
        ((= ans "Ellipse")
         (setq val:multiplier
                (cond
                  ((<= ang1 0.392699) 0.17)
                  ((<= ang1 1.178097) 0.11)
                  ((<= ang1 1.963491) 0.09)
                  ((<= ang1 2.748889) -0.11)
                  ((<= ang1 3.534287) -0.17)
                  ((<= ang1 4.319689) 0.11)
                  ((<= ang1 5.105087) 0.09)
                  ((<= ang1 5.890485) 0.11)
                  (0.17)
                ) ;_ end of cond
         )
         ;; CAB - because the 'leader' & 'insert' code is the sane make it a subroutine
         (put_note (* val:multiplier lts) pnt1 pnt2 cnot)
        ) ; end cond "Ellipse"

        ;;----------------
        ((= ans "Square")
        )

        ;;----------------
        ((= ans "Hexagon")
        )

        ;;----------------
        ((= ans "Triangle")
        )
      ) ; end cond stmt
    ) ; progn
    ;;ELSE user failed to give points
  ) ; endif

  ;;  CAB - moved code here ==========================
  (setvar "cmdecho" cmd) ; Restore variable
  (setvar "filedia" fil) ; Restore variable
  (setvar "clayer" cla) ; Restore variable
  (princ) ; Clear Exit
  ;;=================================================
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.