Error checking advice for large lisp file

Error checking advice for large lisp file

jarredmonday
Collaborator Collaborator
987 Views
5 Replies
Message 1 of 6

Error checking advice for large lisp file

jarredmonday
Collaborator
Collaborator

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)
	   )
  )
)
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
0 Likes
Accepted solutions (1)
988 Views
5 Replies
Replies (5)
Message 2 of 6

jarredmonday
Collaborator
Collaborator

If you happened to scroll this far down I would like if some one could look at this one though...

When exicuted everything is working correctly, but I'm getting an Unknown command "stamp2" message in the command line and there seems to be too much going on to

 

-make layers

-make layer current

-freeze other layers listed

-make color set to Bylayer

 

;;;    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
)
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
0 Likes
Message 3 of 6

dbroad
Mentor
Mentor
Accepted solution

It is easier to maintain an application when there is less code per file.

 

Double lines of asterisks, if used, should be preceeded by 2 or 3 semicolons.

 

When posting large code files, use either attachments or spoiler tags.

 

Vlide has parenthesis matching tools.  Use them to find your missing or extra parentheses.

Architect, Registered NC, VA, SC, & GA.
0 Likes
Message 4 of 6

scot-65
Advisor
Advisor
;****
(if (or (tblsearch "LAYER" "Stamp 2")(tblsearch "LAYER" "Stamp 3")...);or
tblsearch accepts only one argument at a time. [I'm not sure if you want to
use "and" instead of "or"]
;****untested****
(command ".LAYER" "Thaw" "Stamp*" "") ;wildcards acceptable
or
(command ".LAYER" "Thaw "Stamp 2,Stamp 3,Stamp 4,Stamp 5" "") ;comma separation acceptable (no spaces around the comma).
;****untested****
Apply these thoughts and your code's file size will be greatly reduced.

Regarding "all in one file":
I personally set up a .MNL file that is the same name as the CUI that has
"Menu Functions" - meaning there are no keyboard commands "c:" inside.
It is easier to maintain by having separate stand-alone files for the commands.

Create a "Utility.lsp" file that in essence loads and starts these stand-alones:
(defun c:STAMP2 () (load "CurrentLayer-STAMP2")(c:STAMP2)) ;brief description.
Repeat for each file in your "LISP" folder.
Provided the folder where these stand-alone files are located is declared in
the support path (command options, Files tab). If not, it will take some doing
to create a "hard path" prefix: (load (strcat PREFIX "CurrentLayer-STAMP2")).

I could go into creating a function (subroutine) that will handle all those
"STAMP" commands and greatly reduce the coding, but this is another
topic not requested here.
Hint: (defun c:STAMP2 () (MENU-STAMP "Stamp 2"))
Another Hint: (foreach x (list "Stamp 2" "Stamp 3" "Stamp 4" "Stamp 5")...

Hope this helps.

Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.

Message 5 of 6

martti.halminen
Collaborator
Collaborator

 

1) The Lisp loader sees *************** as a symbol named "***************". That gets evaluated, producing NIL, causing no further action,  and the loader proceeds to the next item in the file.

So that won't break anything, just wastes a few milliseconds of time.

 

It might be more stylish to start the separator with a semicolon (or preferably three) so the human reader immediately recognizes it as a comment and doesn't start wondering about the semantics of ******.

 

I use usually ;;; ------------------------ as separator, saving the asterikses to something needing more emphasis.

 

2) The first thing in error checking is to make sure that your parentheses and string quotes match. Vlide gives some services for that, also some other editors. (Most of Common Lisp programmers use some variant of Emacs.) One problem with the Lisp language is that as it allows anything put into a variable and redefining stuff at runtime, there is relatively little that a compiler can catch. So you often need to debug runtime errors. The first step there is enabling Debug>Break on Error in VLIDE. When I get an error, the first thing I look at is usually View>Trace Stack to find out what the program was doing.

 

-- 

Message 6 of 6

jarredmonday
Collaborator
Collaborator

Thank you very much for your replies, they are grately more informative than I was hoping for. I'm going to take most of this and redo my orginization methods and make it more comprehensive.

 

 Im excited!

 

Thank you very much!

Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
0 Likes