Topic: Can someone help me fix my lisp?

[Andrew H]

Can someone help me with my lisp. It keeps getting buggy and I would love to have some of the options changed (like the dimstyle it uses and the layer it uses, etc..) or if you have one that's better please let me know.

Code: [Select]


; FROM THE DESK OF PAUL STANDING And Gary W. Patterson        
; ARCDIM.LSP VS 1.0 MARCH 10 1995 Mod August 7 1996
; MEASURES THE LINEAR LENGTH OF ARCS AND DIMENSIONS THE ARC


  ;; Save and get information from user
  (setq la (getvar "CLAYER")                           ;Save current layer
  );setq

 ;;Create the layer dim
  (command "_layer" "make" "dim" ""            ;Make the layer
                    "_layer" "s" "dim" ""                   ;Set layer
                    "_layer" "c" "magenta" "" "")      ;Set color to red
 
       (defun dtr (x)
        (* pi (/ x 180.00))
        )
       
        (defun rtd (y)
        (/ (* 180 y) pi)
        )
       
       (defun right ()
         (setq ang1 (angle ep cen)
              ang2 (angle ep1 cen)
              ang (- ang1 ang2)
              arclen (abs(* rad ang))
         )
        )
       
        (defun left ()
        (setq ang (- a1 a2))
        (setq arclen (abs(* rad ang)))
        )

;_______________________________________________________________________        

        (defun C:arcdim (/ ang1 ang2 ang arclen rad pick_pt pick_ang
        cen pick_pt extpt1 extpt2 extpt3 extpt4 ep a1 a2 ep1 e6 e7 ent4 temp_pt1
        temp_pt2 temp_pt3 temp_pt4 e1 e2 e3 e4 text_ang th txt1 txt e5 ep1a epa
        ep1a1 epa1 search type)
       
        (setvar "cmdecho" 0)
        (setvar "blipmode" 0)
        (setq cn (entsel "\nSelect arc to dimension: "))
        (setq dn (car cn))
        (setq aw (entget dn))
        (setq type (cdr(assoc 0 aw)))
     (if (= type "ARC")
          (progn
        (setq a1 (cdr (assoc 50 aw)))
        (setq a2 (cdr (assoc 51 aw)))
        (setq cen (cdr (assoc 10 aw))
              rad (cdr (assoc 40 aw)))
        (setq ep (polar cen (cdr (assoc 50 aw)) rad)
              ep1 (polar cen (cdr (assoc 51 aw)) rad))
                  (if (< a1 a2) (left)
                      (right)
                   )
         (prompt "\nEnter dimension location: ")
         (command "dim" "angular" "" cen ep ep1 pause (rtos arclen) pause "exit")
 
            )
        (prompt "\nThe Selected entity was not an arc ")
    )
    (setvar "clayer" "0")
    (setvar "cmdecho" 1)
    (setvar "blipmode" 0)

  ;;Reset the current layer
  (command "_.LAYER" "_S" la "")

                         (princ)
)
        (princ "\nType arcdim to envoke the command: ")

Let me know if you need any information.

[CAB]

SEARCH produced these.

http://theswamp.org/phpBB2/viewtopic.php?t=464

http://theswamp.org/phpBB2/viewtopic.php?t=446&highlight=arc+dim

[Kerry]

Or try this perhaps

http://www.cadvault.com/forums/showpost.php?p=17086&postcount=1

it has continuable dims and selectable node points.

[CAB]

Here is another I had stashed away:

Code: [Select]

;; ARCDIM.LSP Arc Length (c)2000, Created by Bill Farmer
;;Thanks to "Trev" from the CADalog forum for the fractional conversions
;;
;; startup function
(defun start ()
  (undo_chk)
  (setq sysvars (mapcar '(lambda (a b)
                           (setq var (getvar a))
                           (setvar a b)
                           (list a var)
                         )
                        '("cmdecho" "osmode")
                        '(0 512)
                ) ;_ end of mapcar
  ) ;_ end of setq
  ;; save the existing error handler and substitute mine
  (setq old_error *error*
        *error* my_err
  ) ;_ end of setq
) ;_ end of defun

;;check undo function
(defun undo_chk (/ cmde)
  (setq cmde (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if (< (setq undovar (getvar "undoctl")) 5)
    (cond ((= undovar 0) (command "_.undo" "_A"))
          ((= undovar 4) (command "_.undo" "_C" "_A"))
    ) ;_ end of cond
  ) ;_ end of if
  (command "_.undo" "_end")
  (if (wcmatch (getvar "ACADVER") "13*")
    (command "_.undo" "_BEGIN")
    (command "_.undo" "_GROUP")
  ) ;_ end of if
  (setvar "cmdecho" cmde)
) ;_ end of defun

;;Error handling
(defun my_err (s)
  (if (not (member s '("Function cancelled" "console break")))
    (princ (strcat "\nError: " s))
  ) ;_ end of if
  (finish)
) ;_ end of defun
(defun abort (msg)
  (if msg
    (alert
      (strcat "Application error: [name of lsp that is running]\n\n"
              msg
              " \n"
      )
    )
  ) ;_ end of if
  (finish)
  (exit)
) ;_ end of defun
(defun finish ()
  (command "_.undo" "_END")
  (if (< undovar 5)
    (cond ((= undovar 0) (command "_.undo" "_C" "_N"))
          ((= undovar 4) (command "_.undo" "_C" "_0"))
    ) ;_ end of cond
  ) ;_ end of if
  (if sysvars
    (foreach var sysvars (apply 'setvar var))
  ) ;_ end of if
  (if old_error
    (setq *error* old_error
          my_err nil
          old_error nil
    ) ;_ end of setq
  ) ;_ end of if
  (setq sysvars nil
        undovar nil
  ) ;_ end of setq
  (princ)
) ;_ end of defun

;; calculates arc length
(defun arcl ()
  (setq ename (entsel))
  (setq elist (entget (car ename)))
  (setq rad (cdr (assoc '40 elist))) ;RADIUS
  (cond
    ;;get arc info from a segment of a circle
    ((equal "CIRCLE" (cdr (assoc '0 elist)))
     (princ "\nDimensioning an Arc from a segment of a Circle!")
     (princ
       " Arc end points MUST BE PICKED in a COUNTERCLOCKWISE Direction!"
     )
     (setq ctr (cdr (assoc '10 elist))) ;Center Pt
     (setq p1 (getpoint "\nPick 1st Arc End Point: ") ;1st point
           p2 (getpoint "\nPick 2nd Arc End Point: ") ;2nd point
     ) ;_ end of SETQ
     (setq 1sta (angle ctr p1)) ;Calculates 1st ANGLE
     (setq 2nda (angle ctr p2)) ;Calculates 2nd ANGLE
     (if (< 1sta 2nda)
       (progn (setq rang (- 2nda 1sta)) ;ANGLE IN RADIANS
              (setq arl (* rad rang)) ;ARC LENGTH
              (setq carl (* rad (+ (* 2 pi) (- 1sta 2nda))));COMPLIMENTARY ARC LENGTH
       ) ;_ end of progn
       (progn (setq rang (+ (* 2 pi) (- 2nda 1sta))) ;ANGLE IN RADIANS
              (setq arl (* rad rang)) ;ARC LENGTH
              (setq carl (* rad (- 1sta 2nda))) ;COMPLIMENTARY ARC LENGTH
       ) ;_ end of progn
     ) ;_ end of IF
    )
    ;;get arc info from an entire arc
    ((equal "ARC" (cdr (assoc '0 elist)))
     (initget "All Part")
     (setq ask (getkword "\nDimension All or Part of Arc? P/<A> "))
     (cond ((or (= ask "All") (= ask nil))
            (setq 1sta (cdr (assoc '50 elist))) ;1st ANGLE
            (setq 2nda (cdr (assoc '51 elist))) ;2nd ANGLE
           )
           ;; end all of arc
           ;;get arc info from segment of an arc
           ((= ask "Part")
            (setq ctr (cdr (assoc '10 elist))) ;Center Pt
            (setq p1 (getpoint "\nPick 1st Arc End Point: ")) ;1st point
            (setq p2 (getpoint "\nPick 2nd Arc End Point: ")) ;2nd point
            (setq 1sta (angle ctr p1)) ;Calculates 1st ANGLE
            (setq 2nda (angle ctr p2)) ;Calculates 2nd ANGLE
           )
           ;;end part of arc
     ) ;_ end of cond
     (if (< 1sta 2nda)
       (setq rang (- 2nda 1sta)) ;ANGLE IN RADIANS
       (setq rang (+ (* 2 pi) (- 2nda 1sta))) ;ANGLE IN RADIANS
     ) ;_ end of IF
     (setq arl (* rad rang)) ;ARC LENGTH
    )
    ;;end arc info
  ) ;_ end of cond
  ;;end cond
) ;_ end of defun


(defun c:arcdims ()
  (start)
  (setvar "lunits" 5) ;set to Fractional units
  (setq dimmode (getvar "lunits")) ;UNITS
  (setq decpls (getvar "dimdec")) ;DIMENSION DECIMAL PLACES
  (arcl)
  (setq arlt (rtos arl dimmode decpls)) ;CONVERTS VALUE TO STRING
  (if (/= carl nil)
    (setq carlt (rtos carl dimmode decpls)) ;CONVERTS VALUE TO STRING
  ) ;_ end of if
  (cond
    ((equal "CIRCLE" (cdr (assoc '0 elist)))
     (initget "Yes No")
     (setq yesno (getkword "\nDimension Complimentary Angle y/<N>? "))
     (if (or (= yesno "No") (= yesno nil))
       (command "_.dim" "_.ang" "" ctr p1 p2 "_T" arlt pause "" "_.e")
       (progn ;text position for complimentary dim
         (setq txtpos (getpoint "\nPick Text Position.. "));dim compimentary arc segment
         (command "_.dim" "_.ang" "" ctr p1 p2 "_T" carlt txtpos "" "_.e")
       ) ;_ end of progn
     ) ;_ end of if
    )
    ;;end circle/arc dim
    ((equal "ARC" (cdr (assoc '0 elist)))
     (if (= ask "Part")
       (command "_.dim" "_.ang" "" ctr p1 p2 "_T" arlt pause "" "_.e");dim arc segment
       (command "_.dim" "_.ang" ename "_T" arlt pause "" "_.e");dim entire arc
     ) ;_ end of if
    )
    ;;end arc dim
  ) ;_ end of cond
  ;; end cond
  (if (equal "CIRCLE" (cdr (assoc '0 elist)));complimentary arc length display
    (if (= yesno "Yes")
      (princ (strcat "\nComplimentary Arc Length = "
                     (rtos arl dimmode decpls)
             )
      )
      (princ (strcat "\nComplimentary Arc Length = "
                     (rtos carl dimmode decpls)
             )
      )
    ) ;_ end of if
  ) ;_ end of if
  (setvar "lunits" 2) ;set to Decimal units
  (setq a nil ;clear variables
        b nil
        arl nil
        carl nil
        yesno nil
        ename nil
        elist nil
        decpls nil
        dimmode nil
        rang nil
        rad nil
        1sta nil
        2nda nil
        p1 nil
        p2 nil
        arlt nil
        ask nil
        ctr nil
        txtpos nil
        ol_osmode nil
  ) ;_ end of setq
  (finish)
  (princ)
) ;_ end of defun


(princ
  "\nDimensions True Length of an arc. ArcDim Ver 2.5 by Bill Farmer - The CADL Co."
)
(princ "\nType ArcDims")
(princ)

[CAB]

Andrew,

I gave your routine a tune up.
The variable "type" is a reserved word and was most likely
the cause of your problems.

It uses the current DimStyle and the layer "dim".
Just change the "dim" to "MY Layer".

CAB

Code: [Select]

;;; FROM THE DESK OF PAUL STANDING And Gary W. Patterson        
;;; ARCDIM.LSP VS 1.0 MARCH 10 1995 Mod August 7 1996
;;; MEASURES THE LINEAR LENGTH OF ARCS AND DIMENSIONS THE ARC
;;;  06/09/04 Revised by CAB

(defun dtr (x) (* pi (/ x 180.00)))
(defun rtd (y) (/ (* 180 y) pi))

;;;   =================  START OF ROUTINE  =========================
(defun c:arcdim (/  ang1  ang2  arclen  rad      cen  
                    ep    ep1   obtype  userblp  usercmd
                )

  (setq la (getvar "CLAYER"));Save current layer  
  (command "._layer" "make" "dim" "" ;Make the layer
           "._layer" "c" "magenta" "" "") ;Set color to magenta
  (setq usercmd (getvar "CMDECHO"))
  (setvar "cmdecho" 0)
  (setq userblp (getvar "blipmode"))
  (setvar "blipmode" 0)
  (if (setq cn (entsel "\nSelect arc to dimension: "))
    (progn
      (setq aw (entget (car cn)))
      (if (= (cdr (assoc 0 aw)) "ARC")
        (progn
          (setq a1  (cdr (assoc 50 aw))
                a2  (cdr (assoc 51 aw))
                cen (cdr (assoc 10 aw))
                rad (cdr (assoc 40 aw))              
                ep  (polar cen (cdr (assoc 50 aw)) rad)      
                ep1 (polar cen (cdr (assoc 51 aw)) rad)
          )
          (if (< a1 a2)
            (setq arclen (abs (* rad (- a1 a2))))
            (progn
              (setq ang1   (angle ep cen)
                    ang2   (angle ep1 cen)
                    arclen (abs (* rad (- ang1 ang2))))
            )
          )
          (prompt "\nEnter dimension location: ")
          (command "._dim"
                   "_angular"
                   ""
                   cen
                   ep
                   ep1
                   pause
                   (rtos arclen)
                   pause
                   "_exit"
          ) ; command
        ) ;progn
        (prompt "\nThe Selected entity was not an arc.")
      ) ; endif
    ) ;progn
    (prompt "\nNothing Selected ! ")
  ) ; endif
  (setvar "CMDECHO" usercmd)
  (setvar "blipmode" userblp)
  (command "_.LAYER" "_S" la "") ;Reset the current layer
  (princ)
)
(princ "\nType arcdim to envoke the command: ")