Sytax error when joining lisps

Sytax error when joining lisps

christianbaileypaulsen1
Advocate Advocate
668 Views
6 Replies
Message 1 of 7

Sytax error when joining lisps

christianbaileypaulsen1
Advocate
Advocate

I use lots of lisps day to day. I recently tried to combine them all into one file so i can share with my cowokers but they no longer work. Any ideas?

 

;Autocad Fast Commands

; Quickly zoom to an object
(defun C:Z()
  (command "ZOOM" "O"))
;

; Separate solids to current layer
(defun C:SEP()
  (setq slset (ssget))
  (command "SOLIDEDIT" "B" "P" slset "X" "X"))
;

; Change sheet number of pdf reference
(defun c:CSN
  (setq pdf (vlax-ename->vla-object(car(entsel))))
  (setq n (getint "\nSheet number: "))
  (if n
     (vla-put-itemname pdf (itoa n))
)
(vla-update pdf)
(princ))
;

; Copy object in place
(DEFUN C:CIP
      (setq slset (ssget))
	(command "Copy" slset "" "0,0,0" "0,0,0"))
;

; Quick command for copy
(DEFUN C:C
	(command "COPY"))
;

; Copy from base to middle
(DEFUN C:CMID
      (setq slset (ssget))
	(setq pt1 (getpoint "Select Base Point:"))
	(setq pt2 (getpoint "Select 1st Point:"))
	(setq pt3 (getpoint "Select 2nd Point:"))
	(command ".copy" slset "" pt1 "m2p" pt2 pt3))
;

; Quick command for select similar
(DEFUN C:SS
	(command "SELECTSIMILAR"))
;

; Make a flattened elevation of an arc
(defun dtr ( deg ) (* pi (/ deg 180.0)))
(defun c:ELEVFLAT

(SETQ a1 (GETPOINT "\nPICK start piont of ARC:"))
	 (SETQ a2 (GETPOINT "\nPICK 2nd piont of ARC:"))
	  (SETQ a3 (GETPOINT "\nPICK end piont of ARC:"))
	(command "arc" a1 a2 a3)

(setq cm (getvar "cmdecho"))
(setvar"cmdecho" 0)
(setq arcel (entsel "\nSelect an Arc: "))
(while
 (if
   (/= (cdr(assoc 0 (entget(car arcel)))) "ARC") 
    (progn
      (prompt "\nSelected Object is not an ARC")
      (setq arcel (entsel "\nSelect Arc: "))
    )
 )
)
(setq obj (vlax-ename->vla-object (car arcel)))
(setq LEN (vla-get-ArcLength obj))
(command "erase" "last" "")
(setvar "cmdecho" cm)
(princ)

(prompt (strcat "\nThe arc length is "
                                 (rtos len 2 4)
                         )
                 )
		 (princ)

(SETQ Ver (Getdist "\nEnter Panel Height to draw rectangle: <94.5>: "))
	(IF (= Ver nil) (setq ver 94.5))
		(SETQ P1 (GETPOINT "\nPick location for lower left corner of panel:"))
		 (SETQ P2 (POLAR P1 (DTR 0) LEN))
		  (SETQ P3 (Polar P2 (dtr 90) ver))
		   (SETQ P4 (Polar P1 (dtr 90) ver))
	
		 (COMMAND "PLINE" P1 P2 P3 P4 "c"))
;

; Subtract command with option to retain subtracted solid
(Defun c:sub (/ SS1 SS2 YNTST1 OS)
(setvar "cmdecho" 0)
(command "undo" "be")
(prompt "\nSUBTRACT Select objects and regions to subtract from ..")
(setq SS1 (ssget))
(prompt "\nSelect solids and regions to subtract ..")
(setq SS2 (ssget))
(if (= YNTST nil)(setq YNTST "No"))
(initget "No Yes")
(setq YNTST1 (getkword (strcat "\nDelete the objects selected to subtract ? \(Y/N\) <" YNTST "> : ")))
(if (= YNTST1 nil)(setq YNTST1 YNTST)(setq YNTST YNTST1))
(if (= YNTST1 "No")
(progn
 (setq OS (getvar "osmode"))
 (setvar "osmode" 0)
 (command "copy" SS2 "" "0,0,0" "0,0,0")
 (setvar "osmode" OS) 
)
)
(command "subtract" SS1 "" SS2 "")
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)
;

; Change color and linetype to by layer
(defun C:CHH (/ A1 ) 
   (setq A1 (ssget))
(COMMAND "CHANGE" A1 "" "P" "COLOR" "BYLAYER" "LTYPE" "BYLAYER" "") 
)
;

; Bulge Ends of rectangle for dados
(defun c:bulge (/ _Triang _Dbl #Ent #Pnts #Mid #Seg #Read)
  (setq _Triang (lambda (a b c)
                  (- (* (- (car b) (car a)) (- (cadr (trans c 1 0)) (cadr a)))
                     (* (- (cadr b) (cadr a)) (- (car (trans c 1 0)) (car a)))
                  ) ;_ -
                ) ;_ lambda
  ) ;_ setq
  (setq _Dbl
         (lambda (b)
           (vla-setbulge #Ent #Seg b)
           (if (eq 4 (fix (vlax-curve-getendparam #Ent)))
             (or
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-setbulge (list #Ent (+ #Seg 2) b))))
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-setbulge (list #Ent (- #Seg 2) b))))
             ) ;_ or
           ) ;_ if
         ) ;_ lambda
  ) ;_ setq
  (while (and (setq #Ent (entsel "\nSelect LWPolyline Segment: "))
              (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car #Ent)))))
         ) ;_ and
    (and (setq #Seg  (fix (vlax-curve-getparamatpoint
                            (car #Ent)
                            (vlax-curve-getclosestpointto (car #Ent) (cadr #Ent))
                          ) ;_ vlax-curve-getparamatpoint
                     ) ;_ fix
               #Pnts (list (vlax-curve-getpointatparam (car #Ent) #Seg)
                           (vlax-curve-getpointatparam (car #Ent) (1+ #Seg))
                     ) ;_ list
               #Ent  (vlax-ename->vla-object (car #Ent))
         ) ;_ setq
         (cond
           ((zerop (vla-getbulge #Ent #Seg))
            (vla-setbulge #Ent #Seg 1)
            (while (eq 5 (car (setq #Read (grread T 15 0))))
              (if (minusp (_Triang (car #Pnts) (cadr #Pnts) (cadr #Read)))
                (_Dbl 1)
                (_Dbl -1)
              ) ;_ if
            ) ;_ while
           )
           (T (vla-setbulge #Ent #Seg 0))
         ) ;_ cond
    ) ;_ and
  ) ;_ while
  (princ)
)
;

; Move along x axis
(defun C:Mx (/ osm slset pt1 pt2)(terpri)
	 (setq slset (ssget))
	  (setq pt1 (getpoint "Select Base Point of Object to move:"))(terpri)
	   (setq pt2 (getpoint "Select destination .X of:"))(terpri)
	(command ".move" slset "" pt1 ".X" pt2 "@")
)
;

; Move along y axis
(defun C:My (/ osm slset pt1 pt2)(terpri)
	 (setq slset (ssget))
	  (setq pt1 (getpoint "Select Base Point of Object to move:"))(terpri)
	   (setq pt2 (getpoint "Select destination .Y of:"))(terpri)
	(command ".move" slset "" pt1 ".Y" pt2 "@")
)
;

; Move along z axis
(defun C:Mz (/ osm slset pt1 pt2)(terpri)
	 (setq slset (ssget))
	  (setq pt1 (getpoint "Select Base Point of Object to move:"))(terpri)
	   (setq pt2 (getpoint "Select destination .Z of:"))(terpri)
	(command ".move" slset "" pt1 ".Z" pt2 "@")
)
;
0 Likes
Accepted solutions (1)
669 Views
6 Replies
Replies (6)
Message 2 of 7

john.uhden
Mentor
Mentor

@christianbaileypaulsen1 

Do you mean that none of them works anymore?  That doesn't seem right.

I see at least one (vl*) call.  How about adding (vl-load-com) at the top of your file?

 

BTW, how many other christianBaileyPaulsens are there that you have to add a numeric suffix?

John F. Uhden

0 Likes
Message 3 of 7

ВeekeeCZ
Consultant
Consultant
Accepted solution

Read THIS, the first remark specifically. That's your issue multiple times.

 

I would recommend you to not use LISP just for simple shortcuts - as you do for COPY and SELECTSIMILAR. That is the PGP file for. The LISP might launch a different (older) version of the command than AutoCAD itself.

 

And set OSNAPCOORD to 1 if you don't have it already. Or take care of OSNAPs in your lisps.

0 Likes
Message 4 of 7

christianbaileypaulsen1
Advocate
Advocate
@john.uhden

Im the only one i know. I have two emails with it. 1 and 2. One for work and bills and the other for games and random websites and spam.
0 Likes
Message 5 of 7

john.uhden
Mentor
Mentor

@christianbaileypaulsen1 

I am glad to see that you are well rounded.  But one would think you would use #2 here as what we do mostly is play games.

John F. Uhden

0 Likes
Message 6 of 7

john.uhden
Mentor
Mentor

@ВeekeeCZ 

I know you may not have written it, but that help is not entirely true.

There are also symbols that are SUBRs and EXRXSUBRs, and I think there used to be EXSUBRs but I don't see any anymore these days.

John F. Uhden

0 Likes
Message 7 of 7

Sea-Haven
Mentor
Mentor

If you look into "AUTOLOAD" you can demand load lisps when you type command, this is from like you my custom preloaded lisp. Others are just loaded from menu's, toolbars or palettes.

 

(autoload "COPY0" '("COPY0"))
(autoload "COPYCOMMAND" '("ZZZ"))
(autoload "COVER" '("COVER"))
(autoload "DIMFLIP" '("DIMFLIP"))
(autoload "DRAWXFALL" '("DRAWXFALL"))
(autoload "DRAWPIPE" '("DRAWPIPE"))
(autoload "EDITRL" '("EDITRL"))
(autoload "EDITXSECT" '("EDITXSECT"))
(autoload "EDITLSECT" '("EDITLSECT"))
(autoload "FLIPLINE" '("FLIPLINE"))
(autoload "Goto-LAYOUT" '("GOTO"))
(autoload "Goto-LAYOUT" '("GOOT"))

 

 

0 Likes