- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
First off I'm still learning and trying to understand lisp. I was able to accumulate these by searching and asking questions then lightly modifying what i could.
Below I have single text file with 24 different lisps in it. I have a couple of question regarding organization and error checking.
I'm not asking for anyone to sift through this, but rather to direct me on what I should/shoulnd't do.
1) Between each lisp I've separated them with rows of asterisks'. ***************. Are there any problems with this? So far I haven't seen any.
2) What's the best method for error checking? I've loaded this into the Visual Lisp Editor, but I'm just fiddling around with that.
The error(s) I'm having are not affecting the results of these lisps but in the background when Loading each one I'm getting messages in the command promt.
i.e. The window to search for the file reopens after loading and closing. I also have this appear...
Command: APPLOAD
LaSalle Lisp.lsp successfully loaded.
Command: cecolor
Enter new value for CECOLOR <"BYLAYER">: bylayer
Command: APPLOAD
Command: ; error: extra right paren on input
Command:
;;; Generates Total Liniar length of Selected Line (As the crow flies) (defun c:dimpoly (/ DIMENT ENDPT ENT OBJ SEL STARTPT TXT) (defun Get-ObjectID-x86-x64 (obj / util) (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object)) ) ) (if (= (type obj) 'ENAME) (setq obj (vlax-ename-> vla-object obj)) ) (if (= (type obj) 'VLA-OBJECT) ;;(if (> (vl-string-search "x64" (getvar "platform")) 0) ;;not needed in 2012? (vlax-invoke-method util "GetObjectIdString" obj :vlax-False ) ;;(rtos (vla-get-objectid obj) 2 0) ;;) ) ) (while (setq sel (entsel "\nSelect object to dimension: ")) (progn (setq ent (car sel)) (setq obj (vlax-ename->vla-object ent)) (setq startpt (vlax-curve-getpointatparam obj (vlax-curve-getstartparam obj) ) endpt (vlax-curve-getpointatparam obj (vlax-curve-getendparam obj) ) ) (command "_.dimaligned" startpt endpt pause) (setq diment (vlax-ename->vla-object (entlast))) (setq txt (strcat "%<\\AcObjProp Object(%<\\_ObjId " (Get-ObjectID-x86-x64 obj) ">%).Length \\f \"%lu6\">%" ) ) (vla-put-textoverride diment txt) ) ) (princ) ) ****************************************************************** ****************************************************************** ;;; Generates Total length of Selected Lines. (defun C:TPL (/ ss tl n ent itm obj l) (setq ss (ssget) tl 0 n (1- (sslength ss))) (while (>= n 0) (setq ent (entget (setq itm (ssname ss n))) obj (cdr (assoc 0 ent)) l (cond ((= obj "LINE") (distance (cdr (assoc 10 ent))(cdr (assoc 11 ent)))) ((= obj "ARC") (* (cdr (assoc 40 ent)) (if (minusp (setq l (- (cdr (assoc 51 ent)) (cdr (assoc 50 ent))))) (+ pi pi l) l))) ((or (= obj "CIRCLE")(= obj "SPLINE")(= obj "POLYLINE") (= obj "LWPOLYLINE")(= obj "ELLIPSE")) (command "_.area" "_o" itm) (getvar "perimeter")) (T 0)) tl (+ tl l) n (1- n))) (alert (strcat "Total length of selected objects is: " (rtos tl))) (princ) ) ****************************************************************** ****************************************************************** ;;; Draw a Pline with 5" with and Fillets with same width. (defun C:P5 (/ plw filr) ; = PolyLine, Global width, Filleted at all corners (setq plw (getvar 'plinewid) filr (getvar 'filletrad)) (setvar 'plinewid 5) (setvar 'filletrad 5) (command "_.pline") (while (> (getvar 'cmdactive) 0); allows unlimited input (command pause) ); while (command "_.fillet" "_polyline" (entlast)) (setvar 'plinewid plw) (setvar 'filletrad filr) ); defun ****************************************************************** ****************************************************************** ;;; Draw a Pline with 6" with and Fillets with same width. (defun C:P6 (/ plw filr) ; = PolyLine, Global width, Filleted at all corners (setq plw (getvar 'plinewid) filr (getvar 'filletrad)) (setvar 'plinewid 6) (setvar 'filletrad 6) (command "_.pline") (while (> (getvar 'cmdactive) 0); allows unlimited input (command pause) ); while (command "_.fillet" "_polyline" (entlast)) (setvar 'plinewid plw) (setvar 'filletrad filr) ); defun ****************************************************************** ****************************************************************** ;;; Set Current Layer to FL-DUCT0 while turning off other "FL-"layers (defun C:FH0 () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") (if (tblsearch "layer" "FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5") ; if layer 'FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5' exist? (command "layer" "s" "FL-DUCT0" "l" "continuous" "FL-DUCT0" "") ; else, layer 'FL-DUCT0' is not exist (command "layer" "m" "FL-DUCT0" "l" "continuous" "FL-DUCT0" "c" "120" "FL-DUCT0" "") ) (command "layer" "F" "FL-DUCT2" "F" "FL-DUCT3" "F" "FL-DUCT4" "F" "FL-DUCT5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to FL-DUCT2 while turning off other "FL-"layers (defun C:FH2 () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") (if (tblsearch "layer" "FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5") ; if layer 'FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5' exist? (command "layer" "s" "FL-DUCT2" "l" "continuous" "FL-DUCT2" "") ; else, layer 'FL-DUCT2' is not exist (command "layer" "m" "FL-DUCT2" "l" "continuous" "FL-DUCT2" "c" "114" "FL-DUCT2" "") ) (command "layer" "F" "FL-DUCT0" "F" "FL-DUCT3" "F" "FL-DUCT4" "F" "FL-DUCT5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to FL-DUCT3 while turning off other "FL-"layers (defun C:FH3 () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") (if (tblsearch "layer" "FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5") ; if layer 'FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5' exist? (command "layer" "s" "FL-DUCT3" "l" "continuous" "FL-DUCT3" "") ; else, layer 'FL-DUCT3' is not exist (command "layer" "m" "FL-DUCT3" "l" "continuous" "FL-DUCT3" "c" "142" "FL-DUCT3" "") ) (command "layer" "F" "FL-DUCT0" "F" "FL-DUCT2" "F" "FL-DUCT4" "F" "FL-DUCT5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to FL-DUCT4 while turning off other "FL-"layers (defun C:FH4 () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") (if (tblsearch "layer" "FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5") ; if layer 'FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5' exist? (command "layer" "s" "FL-DUCT4" "l" "continuous" "FL-DUCT4" "") ; else, layer 'FL-DUCT4' is not exist (command "layer" "m" "FL-DUCT4" "l" "continuous" "FL-DUCT4" "c" "150" "FL-DUCT4" "") ) (command "layer" "F" "FL-DUCT0" "F" "FL-DUCT2" "F" "FL-DUCT3" "F" "FL-DUCT5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to FL-DUCT5 while turning off other "FL-"layers (defun C:FH5 () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") (if (tblsearch "layer" "FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5") ; if layer 'FL-DUCT0 FL-DUCT2 FL-DUCT3 FL-DUCT4 FL-DUCT5' exist? (command "layer" "s" "FL-DUCT5" "l" "continuous" "FL-DUCT5" "") ; else, layer 'FL-DUCT5' is not exist (command "layer" "m" "FL-DUCT5" "l" "continuous" "FL-DUCT5" "c" "160" "FL-DUCT5" "") ) (command "layer" "F" "FL-DUCT0" "F" "FL-DUCT2" "F" "FL-DUCT3" "F" "FL-DUCT4" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Thaw All FL-Layers. (defun C:FLTHAW () (command "layer" "T" "FL-DUCT0" "T" "FL-DUCT2" "T" "FL-DUCT3" "T" "FL-DUCT4" "T" "FL-DUCT5" "") ) (command "cecolor" "bylayer" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to STAMP 2 while turning off other STAMP layers (defun C:STAMP2 () (command "layer" "T" "STAMP 2" "T" "STAMP 3" "T" "STAMP 4" "T" "STAMP 5" "") (if (tblsearch "layer" "STAMP 2 STAMP 3 STAMP 4 STAMP 5") ; if layer 'STAMP 2 STAMP 3 STAMP 4 STAMP 5' exist? (command "layer" "s" "STAMP 2" "l" "continuous" "STAMP 2" "") ; else, layer 'STAMP 2' is not exist (command "layer" "m" "STAMP 2" "l" "continuous" "STAMP 2" "c" "WHITE" "STAMP 2" "") ) (command "cecolor" "bylayer" "") (command "layer" "F" "STAMP 3" "F" "STAMP 4" "F" "STAMP 5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to STAMP 3 while turning off other STAMP layers (defun C:STAMP3 () (command "layer" "T" "STAMP 2" "T" "STAMP 3" "T" "STAMP 4" "T" "STAMP 5" "") (if (tblsearch "layer" "STAMP 2 STAMP 3 STAMP 4 STAMP 5") ; if layer 'STAMP 2 STAMP 3 STAMP 4 STAMP 5' exist? (command "layer" "s" "STAMP 3" "l" "continuous" "STAMP 3" "") ; else, layer 'STAMP 3' is not exist (command "layer" "m" "STAMP 3" "l" "continuous" "STAMP 3" "c" "WHITE" "STAMP 3" "") ) (command "cecolor" "bylayer" "") (command "layer" "F" "STAMP 2" "F" "STAMP 4" "F" "STAMP 5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to STAMP 4 while turning off other STAMP layers (defun C:STAMP4 () (command "layer" "T" "STAMP 2" "T" "STAMP 3" "T" "STAMP 4" "T" "STAMP 5" "") (if (tblsearch "layer" "STAMP 2 STAMP 3 STAMP 4 STAMP 5") ; if layer 'STAMP 2 STAMP 3 STAMP 4 STAMP 5' exist? (command "layer" "s" "STAMP 4" "l" "continuous" "STAMP 4" "") ; else, layer 'STAMP 4' is not exist (command "layer" "m" "STAMP 4" "l" "continuous" "STAMP 4" "c" "WHITE" "STAMP 4" "") ) (command "cecolor" "bylayer" "") (command "layer" "F" "STAMP 2" "F" "STAMP 3" "F" "STAMP 5" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Layer to STAMP 5 while turning off other STAMP layers (defun C:STAMP5 () (command "layer" "T" "STAMP 2" "T" "STAMP 3" "T" "STAMP 4" "T" "STAMP 5" "") (if (tblsearch "layer" "STAMP 2 STAMP 3 STAMP 4 STAMP 5") ; if layer 'STAMP 2 STAMP 3 STAMP 4 STAMP 5' exist? (command "layer" "s" "STAMP 5" "l" "continuous" "STAMP 5" "") ; else, layer 'STAMP 5' is not exist (command "layer" "m" "STAMP 5" "l" "continuous" "STAMP 5" "c" "WHITE" "STAMP 5" "") ) (command "cecolor" "bylayer" "") (command "layer" "F" "STAMP 2" "F" "STAMP 3" "F" "STAMP 4" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Thaw All STAMP Layers. (defun C:STAMPTHAW () (command "layer" "T" "STAMP 2" "T" "STAMP 3" "T" "STAMP 4" "T" "STAMP 5" "") ) (command "cecolor" "bylayer" "") (princ) ; quiet exit ) ****************************************************************** ****************************************************************** ;;; Set Current Units into Feet or Inches (defun c:UI () (setvar "LUNITS" 2)(princ)) (defun c:UF () (setvar "LUNITS" 4)(princ)) ****************************************************************** ****************************************************************** ;;; Set to current dimstyle by picking desired dimstyle. (defun C:SM () (prompt "\Select Desired Dimstyle...") (command "-DIMSTYLE" "_R" "room dims") (princ) ) ****************************************************************** ****************************************************************** ;;; Specify line width and joins then fillets lines into Plines. (defun c:PJFW(/ FILR GETRAD SS ) (setq getrad (getdist"\n Enter Dist:")) (setq ss (ssget '((0 . "LINE,ARC,LWPOLYLINE,SPLINE")))) (setq filr (setvar "FILLETRAD" getrad)) (command "_.pedit" "_multiple" ss "" "_join" (* getrad 2) "_width" getrad "" "_.fillet" "_polyline" "_last") (princ) ) ****************************************************************** ****************************************************************** ;;; Thaw layer in ALL Viewport. (defun c:vpall() (setq clayout (getvar 'ctab)) (foreach layout (layoutlist) (setvar 'ctab layout) (command "_.vplayer" "_thaw" "*" "_all" "") ) (setvar 'ctab clayout) ) ****************************************************************** ****************************************************************** ;;; Thaw layer in the current Viewport only. (defun c:vpthis() (setq clayout (getvar 'ctab)) (foreach layout (layoutlist) (setvar 'ctab layout) (command "_.vplayer" "_thaw" "*" "" "") ) (setvar 'ctab clayout) ) ****************************************************************** ****************************************************************** ;;; Cycles thru Ortho ON, Polar ON, Both Ortho/Polar OFF. (defun c:TT() (cond ((and (= (logand (getvar 'autosnap) 8) 0) (= (getvar 'orthomode) 0)) ;; = both are off -- turn Polar on: (setvar 'autosnap (+ (getvar 'autosnap) 8)) ) ((= (logand (getvar 'autosnap) 8) 8) (setvar 'orthomode 1)) ;; = Polar is on -- turn Ortho on, which turns Polar off ((setvar 'orthomode 0)) ;; = neither-of-the-above, i.e. Polar is off, Ortho is on -- turn Ortho off ); cond (princ) ) ****************************************************************** ;;; Dimension multiple distances and calculates combined length. (defun c:dii () (setvar "cmdecho" 0) (graphscr) (setq p1 (getpoint "\nPick start point ") p2 (getpoint p1 "\nPick next point ") d1 (distance p1 p2) prdist (strcat "\nDistance: " (rtos d1)) ) (princ prdist) (setq p3 (getpoint p2 "\nPick next point or RETURN if done ")) (while p3 (setq d0 (distance p2 p3) d1 (+ (distance p2 p3) d1) p2 p3 prdist (strcat "\nDistance: " (rtos d0) ", Cumulative distance: " (rtos d1)) ) (princ prdist) (setq p3 (getpoint p2 "\nPick Next Point ")) ) (setq cumd (strcat "Cumulative distance --> " (rtos d1))) (prompt cumd) (princ) ) (princ "\nType CD to run Cumulative Distance") (princ) ****************************************************************** ****************************************************************** ;;; Brings all block names in list to Front using Draworder. (defun c:QW (/ a blkname found lst obj objs ss i blk name) (vl-load-com) (if (and (setq blkname '("4X10 90 BOOT" "4X10 CENTER END BOOT" "DSIZE" "FRIENDSHIPCE" "MIXERBOX" "JUMPER" "FRIENDSHIP90" "CROSSOVERDUCTRETURN" "CROSSOVERDUCT" "CEILINGREGISTER" "CAVALIER REGISTER" "GENERIC D.B." "FLEX BRANCH" "ALUMBOOT" "90-13" "CE-13" "TOEKICK REGISTER" "TITLEBLOCKBOARDER" "SUPPLY NOTE BASE" "RETURN NOTE BASE" "1161B" "BASEBOARD RAG" "14 RISER" "MIXERBOX complex" "Baseboard Returns" "4040MixerBox" "pkg unit"));; (foreach x blkname (if (member x (while (setq a (tblnext "BLOCK" (null a))) (setq lst (cons (strcase (cdr (assoc 2 a))) lst)) lst ) ) (setq found (cons x found)) ) found ) (setq objs (ssadd) ss (ssget "_x" '((0 . "INSERT"))) ) ) (progn (repeat (setq i (sslength ss)) (setq blk (ssname ss (setq i (1- i)))) (setq obj (vlax-ename->vla-object blk)) (setq name (if (vlax-property-available-p obj 'effectivename) (vla-get-effectivename obj) (vla-get-name obj) ) ) (if (member (strcase name) blkname) (ssadd blk objs) ) ) (if objs (command "_.draworder" objs "" "_front") ) ) (cond ((not blkname) (princ "\n Missed name of block ***") ) ((not found) (princ "\n Blocks not found in drawing !!!") ) (t (princ "\n couldn't find any block !!! ") ) ) ) (princ) ) ****************************************************************** ****************************************************************** ;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs) (defun c:ob2wo (/ ent lst nor) (vl-load-com) (if (and (setq ent (car (entsel))) (member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE" "LWPOLYLINE") ) (setq lst (ent2ptlst ent)) (setq nor (cdr (assoc 210 (entget ent)))) ) (progn (vla-StartundoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) (makeWipeout lst nor) (initget "Yes No") (if (= (getkword "\nDelete source object? [Yes/No] <No>: ") "Yes" ) (entdel ent) ) (vla-EndundoMark (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) ) ) ;;; ENT2PTLST ;;; Returns the vertices list of the polygon figuring the curve object ;;; Coordinates defined in OCS (defun ent2ptlst (ent / obj dist n lst p_lst prec) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) ) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 (vlax-get obj 'Normal) ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 ent ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) lst ) ;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object (defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14) (if (not (member "acismui.arx" (arx))) (arxload "acismui.arx") ) (setq dxf10 (list (apply 'min (mapcar 'car pt_lst)) (apply 'min (mapcar 'cadr pt_lst)) (caddar pt_lst) ) ) (setq max_dist (float (apply 'max (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10) ) ) ) (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0))) (setq dxf14 (mapcar '(lambda (p) (mapcar '/ (mapcar '- p cen) (list max_dist (- max_dist) 1.0) ) ) pt_lst ) ) (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14)))) (entmake (append (list '(0 . "WIPEOUT") '(100 . "AcDbEntity") '(100 . "AcDbWipeout") '(90 . 0) (cons 10 (trans dxf10 nor 0)) (cons 11 (trans (list max_dist 0.0 0.0) nor 0)) (cons 12 (trans (list 0.0 max_dist 0.0) nor 0)) '(13 1.0 1.0 0.0) '(70 . 7) '(280 . 1) '(71 . 2) (cons 91 (length dxf14)) ) (mapcar '(lambda (p) (cons 14 p)) dxf14) ) ) )
Solved! Go to Solution.