The weld line lisp code so far.

[elfert]

Hello Forum members..I just want to post..where i am so far with the coding. With the help of your forum members thanks for that.

 

;;Error trapping
(defun error-rout (str)
 (if (/= str "Function cancelled")
     (princ (strcat "\n***ERROR***" str "***"))
 )
 (setq *error* olderr)
 (command "-layer" "s" oldlayer "")       
 (setvar "OSMODE" oldosnap) 
 (setvar "CMDECHO" oldcmdecho)
)
;;Weld line program that draws a polyline for marking of weld signature on sheetmetal parts
(defun c:wzz ( / a d h i l n p q x y y1 y2 y3 y4 d1 n1 oldlayer oldosnap oldcmdecho)
(setq olderr *error*
     *error* error-rout)
;;Getting current Layer
(setq oldlayer  (getvar "clayer"))
;;Getting current cmdecho mode
(setq oldcmdecho (getvar "cmdecho"))
;;Getting current osmode
(setq oldosnap (getvar "osmode"))
;;setting osmode zero
(setvar "OSMODE" 32)
;;setting cmdecho zero
(setvar "cmdecho" 0)
(command "._undo" "begin")
;;Set up Layer DIGI_MARKER_TOOL_1
(if (not (tblsearch "LAYER" "DIGI_MARKER_TOOL_1"))
(Command "-layer" "n" "DIGI_MARKER_TOOL_1" "c" "70" "DIGI_MARKER_TOOL_1" "s" "DIGI_MARKER_TOOL_1" "P" "N" "DIGI_MARKER_TOOL_1" "L" "Continuous" "" "LW" "0.18" "DIGI_MARKER_TOOL_1" "")
;;Setting to created layer
(setvar "clayer" "DIGI_MARKER_TOOL_1"))
;;setting height of weld line
(setq h 20.0)
;;Machine room
(if (and
   (setq x  (getreal "\nWeld Length: "))
   (setq y1 (getreal "\nGuess a Weld length space: "))
   (setq p (getpoint "\n1st Point: "))
   (setq q (getpoint "\n2nd Point: " p))
   (setq p (trans p 1 0)
         q (trans q 1 0)
         a (angle p q)
         d (distance p q)
         i (/ pi 2.0)
        d1 (- d x)
        y3 (+ y1 x)
         n (fix (/ d1 y3))
        n1 (- n 1)
        y4 (/ d1 n)           
           )
       )
       (if (< 0 n)
           (progn
               (setq y (- y4 y3))
               (setq y2 (+ y y1))
               (repeat n
                   (setq l (cons (cons 10 p) l)
                         l (cons (cons 10 (setq p (polar p a x))) l)
                         l (cons (cons 10 (setq p (polar p (- a i) h))) l)
                         l (cons (cons 10 (setq p (polar p a y2))) l)
                         l (cons (cons 10 (setq p (polar p (+ a i) h))) l)
                   )
               )
               (entmake
                   (append
                       (list
                          '(000 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                           (cons 90 (1+ (length l)))
                          '(70 . 0)
                       )
                       (reverse (cons (cons 10 (polar p a x)) l))
                   )
               )
           )
           (princ "\nDistance too small.")
       )
   )
   (princ)
;;setting setting up old layer 
(command "-layer" "s" oldlayer"" )
;;setting osmode to past
(setvar "OSMODE" oldosnap) 
;;setting CMDECHO to past
(setvar "CMDECHO" oldcmdecho)
)

But the warning if the distance between the two points is smaller then the weld length or and the weld spacing is not working. Any clues......?

 

Help Please!