Message 1 of 7
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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 "@")
)
;
Solved! Go to Solution.