Extrude lisp for Bricscad Classic

Randy Mahoney
Randy Mahoney
in Linux

For those who might find it useful, here's a front end for the tabsurf command that kind of imitates Autocad's extrude.

 

; EXTRUDE.LSP - to approximate the Autocad EXTRUDE command for Intellicad Std and Bricscad Classic.;   Draws wireframe extrusion of open or closed lwpolyline.;   Entering height value extrudes perpendicular or select points on path for direction.;   No option for taper. ; 10-27-10 Bricscad and Intellicad version ; 10-28-10 Added bulge detection/facet option, polyline delete option and height/path option; 11-24-10 Added pre-pick handling; 12-29-10 Added selection type check(defun bdet (alist / x bf)     (setq bf nil)  (foreach x alist    (if (eq 42 (car x))      (if (/= (cdr x) 0)        (setq bf T)      )    )  ) bf)(defun c:ext (/ *ERROR* p2 cesys systab lname poly polyen vert hp exv exx exy exz uchk ssgf) (defun *ERROR* (msg)   (setvar "CMDECHO" cesys)   (setvar "SURFTAB1" systab)   (princ) ) (setq cesys (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq systab (getvar "SURFTAB1")) (setq ssgf (ssget "I")) (if (not ssgf)   (progn     (while (not poly)       (setq poly (car (entsel "\n Select a lwpolyline to extrude : ")))     )     (redraw poly 3)   )   (setq poly (ssname ssgf 0)) ) (setq polyen (entget poly)) (if (/= (cdr (assoc 0 polyen)) "LWPOLYLINE")   (progn     (princ "\n Selection must be lwpolyline")     (exit)   ) ) (setq vert (cdr (assoc 90 polyen)))    (setvar "SURFTAB1" vert)    (if (bdet polyen)       (progn     (initget 7)     (setq vert (getint "\n Number of facets : "))     (setvar "SURFTAB1" vert)   ) ) (initget 128) (setq hp (getpoint "\n\n Enter height of extrusion or select point on path : ")) (if (listp hp)   (progn     (setq p2 (getpoint hp "\n Select other point on path : "))     (command "._LINE" hp p2 "")     (setq lname (entlast))   )   (progn     (setq exx (car (cdr (assoc 210 (entget poly)))))     (setq exy (cadr (cdr (assoc 210 (entget poly)))))     (setq exz (caddr (cdr (assoc 210 (entget poly)))))     (setq hp (atof hp))     (setq exv (list (* exx hp) (* exy hp) (* exz hp)))     (command "._LINE" (list 0 0 0) exv "")     (setq lname (entlast))    ) ) (command "._TABSURF" poly lname) (entdel lname) (initget 128 "No") (setq uchk (getkword "\n Delete base polyline? (N)o <Yes> : ")) (if (not uchk)   (entdel poly) ) (redraw) (setvar "CMDECHO" cesys) (setvar "SURFTAB1" systab) (princ))

 

 

Comments

This discussion has been closed.