Please help me with this code

Please help me with this code

Anonymous
Not applicable
396 Views
1 Reply
Message 1 of 2

Please help me with this code

Anonymous
Not applicable

Is there a solution for getting the classic LISP websec to work in autocad 2016? The code is below. I have tried replacing "command" with "command-s" in accordance with the autolisp help page suggestion, but have not been able to get the below routine to give anything other than a wc internal error, a command-s error, or upon entering an insertion point, a polyline is begun. Thank you for your time looking, and Godspeed.

 

;;;   WEBSEC.lsp
;;;   Copyright (C) 1991 by Autodesk, Inc.
;;; 
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted. 
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;   by Carl B. Bethea 
;;;   2 June 91
;;;   based on a routine
;;;   by Tommie Ruble
;;;   Drafting Technology Services, Inc.
;;;
;;;
;;;-- getnum -----------------------------------------------
;;;   get a distance, disallow null, 0, or negative
;;;
(defun getnum (string)
   (initget 7)
   (getdist string)
)
;;;
;;;-- draw_pline -------------------------------------------
;;;   generic pline engine
;;;
(defun draw_pline (/ dxdy)

   ;; if start point not defined, then get one
   ;; see tube for why this check is useful
   (if (null ip)
       (setq IP (getpoint "\nInsertion Point: "))
   )
   (command "pline" ip
      (mapcar
        '(lambda (dxdy)

            ;; if the entry from the data table is longer than
            ;; an x-y-z list, then execute the command(s) at the
            ;; the beginning of the entry,
            ;; then truncate the entry to x-y-z
            (while  (> (length DXDY) 3)
                    (command-s (car DXDY))
                    (setq DXDY (cdr DXDY))
            )

            ;; generate a point based on dx dy dz
            ;; from the last point
            (command
               (setq IP
                  (mapcar '(lambda (i j) (+ i (eval j)))
                           IP
                           dxdy
                  )
               )
            )
         )
         data_table
      );mapcar
   );commnd
);draw_pline
;;;
;;;-- w ----------------------------------------------------
;;;   draw an W-section
;;;   starts at lower left corner, runs clockwise
;;;
(defun w (/ d e f h a b)
   (setq
      D (getnum "\nDepth            ==> ")
      E (getnum "\nWeb Thickness    ==> ")
      F (getnum "\nFlange Width     ==> ")
      H (getnum "\nFlange Thickness ==> ")
   )
   (w_draw d e f h)
);w

(defun w_draw (d e f h / a b data_table ip)
   (setq
      A (- (/ F 2) (/ E 2) H)
      B (- D (* 4 H))
 
      ;; create a data table which describes the
      ;; dx, dy, dz values for each point of the section
      ;; note all arcs are assumed tangent to previous line

      data_table
           '((0 H 0)  
             (A 0 0)
             ("ARC"   H H 0)
             ("LINE"  0 B 0)
             ("ARC"   (- H) H 0)
             ("LINE"  (- A) 0 0)
             (0 H 0)
             (F 0 0)
             (0 (- H) 0)
             ((- A) 0 0)
             ("ARC"   (- H) (- H) 0)
             ("LINE"  0 (- B) 0)
             ("ARC"   H (- H) 0)
             ("LINE"  A 0 0)
             (0 (- H) 0)
             ((- F) 0 0)
            );end table
   );setq
   (draw_pline)
);web
;;;
;;;-- s ----------------------------------------------------
;;;   draw s-section
;;;
(defun s (/ d e f h)
   (setq
      D (getnum "\nDepth            ==> ")
      E (getnum "\nWeb Thickness    ==> ")
      F (getnum "\nFlange Width     ==> ")
      H (getnum "\nAvg Flange Thk   ==> ")
   )
   (s_draw d e f h)
);s

(defun s_draw (d e f h / a b m i L x y data_table ip)
   (setq
      A (- (/ F 2) (/ E 2))
      M (* 0.15838444 (/ A 2.0))
      B (- D (* 2 (+ M H)))
      I (atan A (* 2 M))              ; internal angle of arc
      L (- H M)                       ; tangent length of fillet
      Y (polar '(0 0 0) (- (/ pi 2) I) L)
      X (car Y)                       ; dx of fillet
      Y (cadr Y)                      ; dy of fillet

      data_table
           '(("ARC"  "DIRECTION" 0 (- H M) 0)  
             (X Y 0)
             ("LINE"  (- A X) (- (* 2 M) Y) 0)
             (0 B 0)
             ((- X A) (- (* 2 M) Y) 0)
             ("ARC"  "DIRECTION" (- X) Y 0)  
             (0 L 0)
             ("LINE"  F 0 0)
             ("ARC"  "DIRECTION" 0 (- M H) 0)  
             ((- X) (- Y) 0)
             ("LINE"  (- X A) (- Y (* 2 M)) 0)
             (0 (- B) 0)
             ((- A X) (- Y (* 2 M)) 0)
             ("ARC"  "DIRECTION"  X (- Y) 0)  
             (0 (- L) 0)
             ("LINE"  (- F) 0 0)
            );end table
   );setq
   (draw_pline)
);s
;;;
;;;-- channel ----------------------------------------------
;;;   draw channel section
;;;
(defun channel (/ d e f h)
   (setq
      D (getnum "\nDepth            ==> ")
      E (getnum "\nWeb Thickness    ==> ")
      F (getnum "\nFlange Width     ==> ")
      H (getnum "\nAvg Flange Thk   ==> ")
   )
   (c_draw d e f h)
);channel

(defun c_draw (d e f h / a b m i L x y data_table ip)
   (setq
      A (- F  E)
      M (* 0.15838444 (/ A 2.0))
      B (- D (* 2 (+ M H)))
      I (atan A (* 2 M))              ; internal angle of arc
      L (- H M)                       ; tangent length of fillet
      Y (polar '(0 0 0) (- (/ pi 2) I) L)
      X (car Y)                       ; dx of fillet
      Y (cadr Y)                      ; dy of fillet

      data_table
           '((0 D 0)
             (F 0 0)
             ("ARC"  "DIRECTION" 0 (- M H) 0)  
             ((- X) (- Y) 0)
             ("LINE"  (- X A) (- Y (* 2 M)) 0)
             (0 (- B) 0)
             ((- A X) (- Y (* 2 M)) 0)
             ("ARC"  "DIRECTION"  X (- Y) 0)  
             (0 (- L) 0)
             ("LINE"  (- F) 0 0)
            );end table
   );setq
   (draw_pline)
);channel
;;;
;;;-- angled -----------------------------------------------
;;;   draw angle section
;;;
(defun angled (/ d f h)
   (setq
      F (getnum "\nHorizontal Length ==> ")
      D (getnum "\nVertical Length   ==> ")
      H (getnum "\nAngle Thickness   ==> ")
   )
   (a_draw f d h)
);angled

(defun a_draw (f d h / data_table ip)
   (setq
      data_table
           '((0 D 0)
             ("ARC"  "DIRECTION" H 0 0)  
             (0 (- H) 0)
             ("LINE"  0 (- (* 2 H) D) 0)
             ((- F (* 2 H)) 0 0)
             ("ARC"   H (- H) 0)  
             ("LINE"  (- F) 0 0)
            );end table
   );setq
   (draw_pline)
);angled
;;;
;;;-- tube -------------------------------------------------
;;;   draw tube section
;;;
(defun tube (/ d f h h2)
   (setq
      F (getnum "\nHorizontal Length ==> ")
      D (getnum "\nVertical Length   ==> ")
      H (getnum "\nWall Thickness    ==> ")
     IP (getpoint "\nInsertion Point: ")
   )
   (t_draw f d h ip)
);tube

(defun t_draw (f d h ip / h2 data_table)
   (setq
     H2 (* 2 H)
     ip (list (car ip) (+ H2 (cadr ip))(caddr ip))
  
      ;; section for the outer tube
      data_table
           '((0 (- D H2) 0)
             ("ARC"   H2 H2 0)  
             ("LINE"  (- F H2) 0 0)
             ("ARC"   H2 (- H2) 0)  
             ("LINE"  0 (- H2 D) 0)
             ("ARC"   (- H2) (- H2) 0)  
             ("LINE"  (- H2 F) 0 0)
             ("ARC"   (- H2) H2 0)
            );end table
   );setq
   (draw_pline)

   (setq
     ip (list (+ H (car ip)) (cadr ip)(caddr ip))
  
      ;; inside tube
      data_table
           '((0 (- D H2) 0)
             ("ARC"   H H 0)  
             ("LINE"  (- F H2) 0 0)
             ("ARC"   H (- H) 0)  
             ("LINE"  0 (- H2 D) 0)
             ("ARC"   (- H) (- H) 0)  
             ("LINE"  (- H2 F) 0 0)
             ("ARC"   (- H) H 0)
            );end table
   );setq
   (draw_pline)

);angled
;;;
;;;-- err --------------------------------------------------
;;;
(defun err (s)
   (if (/= s "Function cancelled")
       (princ (strcat "\nError: " s))
   )
   (setq *error* olderr)
   (setvar "cmdecho" cm)
   (princ)
)
;;;
;;;-- c:websec ---------------------------------------------
;;;   main program to draw beam sections
;;;
(defun c:websec (/ option ip cm olderr)
   (setq cm (getvar "cmdecho")
      olderr  *error*
      *error* err
   )
   (setvar "cmdecho" 0)
   (initget "W S Channel Angled Tube ")
   (if (null (setq option
          (getkword "\nAngled/Channel/S/Tube/<W>: ")
       ))
       (setq option "W")
   )
   (eval (list (read option)))
   (setq *error* olderr)
   (setvar "cmdecho" cm)
   (princ)
)
;;;
;;;--- end of file -----------------------------------------

 

 

0 Likes
397 Views
1 Reply
Reply (1)
Message 2 of 2

ВeekeeCZ
Consultant
Consultant

Try draw_pline function // from (defun draw_pline to );draw_pline // replace with this..

 

Spoiler
(defun draw_pline (/ dxdy lst)
  ;; if start point not defined, then get one
  ;; see tube for why this check is useful
  (if (null ip)
    (setq IP (getpoint "\nInsertion Point: "))
  )

  (setq lst (cons ip lst))
  (mapcar
    '(lambda (dxdy)
       ;; if the entry from the data table is longer than
       ;; an x-y-z list, then execute the command(s) at the
       ;; the beginning of the entry,
       ;; then truncate the entry to x-y-z
       (while (> (length DXDY) 3)
	 (setq lst (cons (car DXDY) lst))
	 (setq DXDY (cdr DXDY))
       )
       ;; generate a point based on dx dy dz
       ;; from the last point
       (setq lst (cons (setq IP (mapcar '(lambda (i j) (+ i (eval j)))
					IP
					dxdy))
		       lst))
       )
    data_table
  );mapcar

  (setq lst (reverse lst))
  (command "_PLINE")
  (foreach e lst (command e))
  (command "")
)