MS Access Developer

Help with design, development or repair of your Microsoft Access database.

Some things about me:

– 15 years of experience as an independent consultant for Access development projects
– Many references.
– Masters degree in Biostatistics.
– Have taught business development at the Boulder Small Business Development Center.

I can wrap my mind around just about any project you might throw at me.

Let me know what I can do to help your business!

Currently accepting projects of any size. Will work via virtual office or on-site (in the Denver/Boulder area). Discounted rate schedule for non-profit organizations and green businesses.

Expertise in:
– understanding what you really want and providing it!
– developing new databases from beginning to end
– fixing your current MS Access database to run faster, more reliably, and fully featured
– building easy-to-use user interfaces
– creating dashboards to display your current key data points, at a glance
– incorporating intelligence into the flow and logic of your database
– utilization of extreme mathematical calculations
– training you to develop/use your own MS Access databases
– integrating MS Access databases with other databases, such as Quickbooks

Skilled at:

– all versions of MS Access, and conversion between versions
– VBA programming
– mathematics, statistics, business intelligence, data mining
– small business finance
– database design
– staying on target, on budget, on deadline

https://boulder.craigslist.org/cps/6779573807.html

vsnap lisp

(DEFUN C:VSNAP (/)

; Sept. 25,97. By V.Mendez
; This function centers an object between two parallel lines.

(SETVAR “CMDECHO” 0)
(SETQ SelObj (ENTSEL “\nSelect Object : “))
(SETQ BPoint (GETPOINT “\nBase Point : “))
(COMMAND “OSNAP” “NONE”)
(COMMAND “OSNAP” “NEA”)
(SETQ Point1 (GETPOINT “\nFirst Point [nearest] : “))
(COMMAND “OSNAP” “PER”)
(SETQ Point2 (GETPOINT Point1 “\nSecond Point [Perpendicular] : “))
(COMMAND “OSNAP” “NONE”)
(SETQ X1 (CAR Point1)
Y1 (CADR Point1)
Z1 (CADDR Point1)
)
(SETQ X2 (CAR Point2)
Y2 (CADR Point2)
Z2 (CADDR Point2)
)
(SETQ XMid (/ (+ X2 X1) 2)
YMid (/ (+ Y2 Y1) 2)
ZMid (/ (+ Z2 Z1) 2)
)
(SETQ XObj (CAR BPoint)
YObj (CADR BPoint)
ZObj (CADDR BPoint)
)
(COND
((AND (= X1 X2) (= Y1 Y2)) (SETQ MidPoint (LIST XObj YObj ZMid)))
((AND (= X1 X2) (= Z1 Z2)) (SETQ MidPoint (LIST XObj YMid ZObj)))
((AND (= Y1 Y2) (= Z1 Z2)) (SETQ MidPoint (LIST XMid YObj ZObj)))
)
(COMMAND “MOVE” SelObj “” BPoint MidPoint)
(SETVAR “CMDECHO” 1)
)

Plocky Lisp

(Defun FC (Func N Xo dx)
(
(Setq LP ‘())
(Setq Int (/ dx N)
(Setq x (-Xo Int))
(Repeat (+ N 1)
(Setq x (+x Int))
(Setq y (FuncA x))
(Setq LPP (List x y))
(Setq LP (Cons LPP LP))
)
)
)
(Defun FuncA (V)
(* V V)
)
(Defun DrawF (ListP)
(Setq LPG ListP)
(While ((Lenght LPG) >= 2)
(Setq P1 (Car LPG))
(Setq P2 (Cadr LPG))
(Command “Line” P1 P2)
(Setq LPG (Cdr LPG))
)
)

mcrouti3 lisp

; If an error (such as CTRL-C) occurs
; while this command is active…
(defun at_err (st)
(if (and (/= st “Function cancelled”) (/= st “quit / exit abort”))
(princ (strcat “\nError: ” st))
);end if

;Restore modified modes
(setvar “regenmode” 1)
(setvar “cmdecho” 1)

(if (= (type rtfile) ‘FILE)
(close rtfile)
);end if

(setq rtfile nil)

; Restore old *error* handler
(setq *error* olderr)
(princ)
);end defun

;This function disconnect all variables inside itself.
(defun DiscVar ()
(setvar “regenmode” 0)
(setvar “cmdecho” 0)
);end defun

(defun C:BB ()
(setq bb(entget(car(entsel))))
(setq name (cdr(assoc 2 bb)))
(setq name (strcat “Block Name : ” name))
(alert name)
(princ)
);end defun

(defun c:CC()
(setq bb(entget(car(entsel))))
(setq name (cdr(assoc 8 bb)))
(setq name (strcat “Entity Layer : ” name))
(alert name)
(princ)
)

(defun C:BM (/ a a1 a2 nam ins bk1)

(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

(command “explode” a )
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(command “move” a2 “” a2 pause)

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “” )
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:BE ( ) ;/ a a1 a2 nam ins bk1)
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE BLOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a)
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(command “erase” a2 “”)

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)

(setvar “regenmode” 1)
(princ)
);end defun

(defun C:bda (/ a a1 a2 bm bk1 inf nam ins )
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE BLOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))

;PUNTOFINALDATA
;ERASE ENTITIES
(command “ddatte” a2 )

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “” )
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:ba (/ blo a a1 a2 nam ins bk1)

;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ssget))
(setq blo (entsel))
(setq inf(entget(car blo)))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

(command “explode” blo)
(setq bk1 (ssget “p”))

(command “block” nam “y” ins bk1 a “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “”)
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:bs (/ a a1 a2 bk1 inf nam ins )
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(setq p1 (getpoint))
(setq p2 (getcorner p1))
(SETQ A(ssget “c” p1 p2))
(setq b (entget(ssname a 0)))

(setq nam(cdr(assoc 2 b)))
(setq ins(cdr(assoc 10 b)))
(setq capa (cdr(assoc 8 b)))

(command “explode” a)
(setq bk1 (ssget “p”))

;stretch ENTITIES
(command “stretch” “c” p1 p2 “” p2 pause)
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “”)
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:bop (/ a a1 a2 nam ins bk1)
;VARS SETTINGS
(setvar “regenmode” 0)

(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE LOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a)
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(command “copy” a2 “” a2 pause)

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “”)
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:bco (/ a a1 a2 nam ins bk1)
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE LOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a)
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(command “change” a2 “” “p” “lt” “continuous” “”)

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “”)
(setvar “regenmode” 1)
(princ)
);end defun

(DEFUN C:bhi (/ a a1 a2 nam ins bk1)

(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE LOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(command “change” a2 “” “p” “lt” “hidden” “”)

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “”)
(setvar “regenmode” 1)
(princ)
);end defun
(DEFUN C:bcl (/ a a1 a2 nam ins bk1)

;; VARS SETTINGSq
(setvar “regenmode” 0)
(setvar “cmdecho” 0)
;; Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))
;; FUTURE LOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))
;; AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))
;; ERASE ENTITIES
(command “change” a2 “” “p” “c” 8 “”)
;; MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “” )

(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:b8 (/ a a1 a2 nam ins bk1)

;; VARS SETTINGSq
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;; Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;; FUTURE LOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa(cdr(assoc 8 inf)))
;; AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))
;; ERASE ENTITIES
(command “change” a2 “” “p” “c” 8 “”)
;; MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa “” )

(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:TKI (/ ) ;a a1 a2 nam ins bk1)
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;ENTITIES SELECTION
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE BLOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa2(cdr(assoc 8 inf)))

;EXPLODE MODULE
(command “explode” a )
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(setq nooo 0)
(repeat (sslength bk1)
(setq capa(ssname bk1 nooo))
(setq asso(cdr(assoc 8(entget capa))))
(SETQ BLO(CDR(ASSOC 2(ENTGET CAPA))))
(setq loc(cdr(assoc 10(entget capa))))
(setq ref(cdr(assoc 0(entget CAPA))) )

(IF (= “ITEMTAG” BLO)
(COMMAND “SCALE” CAPA “” LOC “1.6”)
)
(IF (= “RECTRAG” BLO)
(COMMAND “SCALE” CAPA “” LOC “1.6”)
)

(setq nooo(+ nooo 1))
);repeat

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )
(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:TEI (/ ) ;a a1 a2 nam ins bk1)
;VARS SETTINGS
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

;Seleccion de entidades
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

;FUTURE BLOCK INFORMATION
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa2(cdr(assoc 8 inf)))

;AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))

;ERASE ENTITIES
(setq nooo 0)
(repeat (sslength bk1)
(setq capa(ssname bk1 nooo))
(setq asso(cdr(assoc 8(entget capa))))
(SETQ BLO(CDR(ASSOC 2(ENTGET CAPA))))
(setq loc(cdr(assoc 10(entget capa))))
(setq ref(cdr(assoc 0(entget CAPA))) )

(IF (OR (= “PTAGM” BLO)(= “ETAGM” BLO)(= “EPTAGM” BLO)(= “ERITAG” BLO)(= “PRITAG” BLO)(= “ELLIPPLM” BLO)(= “ELLIPTAG” BLO))
(COMMAND “SCALE” CAPA “” LOC “1.6”)
)
(setq nooo(+ nooo 1))
);repeat

;MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )
(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:BO (/ bb name)
(setq bb(entget(car(entsel))))
(setq name (cdr(assoc 2 bb)))
(setq name (strcat “d:\\MCD_PR\\SOFTDESK\\” name “.DWG”))
(command “save” “”)
(command “open” name)
(princ)
)

(DEFUN C:TCI (/ ) ;a a1 a2 nam ins bk1)
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))

(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa2(cdr(assoc 8 inf)))

;; AQUI VA EL MODULO DE EXPLODE
(command “explode” a )
(setq bk1 (ssget “p”))

;; ERASE ENTITIES
(setq nooo 0)
(repeat (sslength bk1)
(setq capa(ssname bk1 nooo))
(setq asso(cdr(assoc 8(entget capa))))
(SETQ BLO(CDR(ASSOC 2(ENTGET CAPA))))
(setq loc(cdr(assoc 10(entget capa))))
(setq ref(cdr(assoc 0(entget CAPA))))

(IF (OR (= “3NOTE” BLO)(= “2NOTE” BLO)
(= “1NOTE” BLO)(= “4NOTE” BLO))

(COMMAND “SCALE” CAPA “” LOC “1.6”)
)

(setq nooo(+ nooo 1))
);repeat

;; MAKE BLOCK MODIFIED
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )

(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:TCD (/ ) ;a a1 a2 nam ins bk1)
(setvar “regenmode” 0)
(setvar “cmdecho” 0)

(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ A2 (car(cdr a)))

(setq Inf (entget A1))
(setq Nam(cdr(Assoc 2 Inf)))
(setq Ins(cdr(Assoc 10 Inf)))
(setq Capa2(cdr(Assoc 8 Inf)))

(command “explode” a)
(setq Bk1 (ssget “p”))

(setq Nooo 0)
(repeat (sslength Bk1)
(setq Capa (ssname Bk1 Nooo)
Asso (cdr(assoc 8(entget Capa)))
Blo (cdr(assoc 2(entget Capa)))
Loc (cdr(assoc 10(entget Capa)))
Ref (cdr(assoc 0(entget Capa)))
);setq end

(if (OR (= “3NOTE” BLO)(= “2NOTE” BLO)(= “1NOTE” BLO)(= “4NOTE” BLO))
(COMMAND “SCALE” CAPA “” LOC (/ 1 1.6))
);end if
(setq nooo(+ nooo 1))
);repeat

(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )

(setvar “regenmode” 1)
(princ)
);End_Defun

(DEFUN C:bbn (/ n p1 n1 n2 a co al1 cp cp2 t)
; Copia un bloque con nombre diferente
(setq n (entsel))
(setq p1 (car(cdr n)))

(command “copy” n “” p1 pause)
(setq n1(cdr(assoc 2(entget(car n)))))
(setq n2 (strcat (substr n1 1 7) “*”))
(setq a(ssget “x”(list(cons 0 “INSERT”) (cons 2 N2))))
(setq co (sslength a))
(setq al1 (strcat “TIENES ” (ITOA CO) ” BLOQUES.”))
(setq cp (ssget “l”))
(setq cp2 (entget(ssname cp 0)))
(command “explode” cp “”)
(setq t (ssget “p”))
(command “block” (strcat(substr n1 1 8)”_”(itoa co))
(cdr(assoc 10 cp2)) t “” )
(command “insert” (strcat(substr n1 1 8)”_”(itoa co))
(cdr(assoc 10 cp2)) “” “” “”)
(ALERT AL1)
(princ)
)

Tblin AutoLisp Modes

(defun c:tblin (/)

;Initialize counters.
(setq Row 0)
(setq Col 0)
;Change these variables to adjust row and columns.
(setq OffCol 2)
(setq OffRow 0.2)

(setq ColMax 9)
(setq eof 0)

(setq Filename (FileToRead))
(setq FileHandler (open Filename “r”))

(while (= eof 0)
(progn
(while (< Col (* OffCol ColMax)) (progn (setq TextIn (read-line FileHandler)) (if (= TextIn “~”) (setq eof 1) ;Else (progn (setq Col (+ Col OffCol)) (command “TEXT” (list Col Row 0.0) “0.08” “0” TextIn) );End progn );End if );End progn );wend (setq Row (- Row OffRow)) (setq Col 0) );End progn );Wend (close FileHandler) (princ) ) (defun FileToRead (/) ; Prompt for file to be inserted (if (= 1 (getvar “FILEDIA”)) (setq FileToRead (getfiled “File to Read” “” “TXT” 12)) ;Else (progn (\n princ “Set variable FILEDIA to 1 then try again.”) (setq FileToRead nil) );End progn );End if ) ;;; Save modes ;;; (defun MODES (a) (setq MLST ‘()) (repeat (length a) (setq MLST (append MLST (list (list (car a) (getvar (car a)))))) (setq a (cdr a)) ) ;;; Restore modes ;;; (defun MODER () (repeat (length MLST) (setvar (caar MLST) (cadar MLST)) (setq MLST (cdr MLST)) ) ) ;;; Ascii Text error handler ;;; (defun at_err (st) ; If an error (such as CTRL-C) occurs ; while this command is active… (if (and (/= st “Function cancelled”) (/= st “quit / exit abort”) ) (princ (strcat “\nError: ” st)) ) (moder) ; Restore modified modes (if (= (type rtfile) ‘FILE) (close rtfile) ) (setq rtfile nil) (setq *error* olderr) ; Restore old *error* handler (princ) ) (defun asctxt (/) (setq olderr *error* *error* at_err) (modes ‘(“BLIPMODE” “CMDECHO” “HIGHLIGHT”)) ; Prompt for file to be inserted (while (null rtfile) (if (null at_fnm) (if (= 1 (getvar “FILEDIA”)) (setq rf (getfiled “File to Read” “” “” 12)) (progn (initget 1) (princ “\nFile to read (including extension): “) (setq rf (getstring)) ) ) (if (= 1 (getvar “FILEDIA”)) (setq rf (getfiled “File to Read” at_fnm “” 12)) (progn (princ “\nFile to read (including extension)/<“) (princ (strcat at_fnm “>: “))
(setq rf (getstring))
)
)
)
(if (= rf nil) (exit))
(if (= rf 1)
(if (null at_fnm)
(progn
(initget 1)
(princ “\nFile to read (including extension): “)
(setq rf (getstring))
)
(progn
(princ “\nFile to read (including extension)/<“) (princ (strcat at_fnm “>: “))
(setq rf (getstring))
)
)
)
(if (and (= rf “”) (/= nil at_fnm))
(setq rf at_fnm)
)
(setq rfa (findfile rf))
(if (= “~” rf)
(progn
(setq rfa nil)
(setq rtfile nil)
)
)
(if rfa
(progn
(setq at_fnm rfa)
(if (null (setq rtfile (open rfa “r”)))
(princ (strcat
“\n\tFile found, but couldn’t open ” at_fnm ” for reading. “))
)
)
(if (/= “~” rf)
(if (and (< 4 (strlen rf)) (/= (substr rf (- (strlen rf) 3) 1) “.”) ) (princ “\nFile not found. Extension may be missing.”) (princ “\nFile not found. “) ) ) ) ) (setq cont T) (if (= “Yes” (getkword “\nSet up columns? : “))
(progn
(setq opt (append opt ‘(16)))
(initget (+ 1 2))
(setq cd (getdist pt “\nDistance between columns: “))
(initget (+ 1 2 4))
(setq nl (getint “\nNumber of lines per column: “))
)
)
)
)
(setvar “BLIPMODE” 0)
(setvar “HIGHLIGHT” 0)
(setvar “CMDECHO” 0)
(setq eof nil)
(setq s (repeat l1
(read-line rtfile)
))
(setq lc (1+ lc))
(1ltxt)
(while (null eof)
(if (= d “Auto”)
(progn
(setq s (read-line rtfile))
(setq lc (1+ lc))
(if s
(progn
(if (= lc (1+ nl))
(1ltxt)
(progn
(if (member ‘1 opt)
(setq s (strcat “%%u” s “%%u”))
)
(if (member ‘2 opt)
(setq s (strcat “%%o” s “%%o”))
)
(if (member ‘4 opt)
(setq s (strcase s))
)
(if (member ‘8 opt)
(setq s (strcase s T))
)
(command “_.TEXT” “” s)
(setq c (1+ c))
(if (= c n)
(setq eof T)
)
)
)
)
(setq eof T)
)
)
(progn
(setq s (read-line rtfile))
(setq lc (1+ lc))
(if s
(1ltxt)
(setq eof T)
)
)
)
)
(close rtfile)
(setq rtfile nil)
(moder) ; Restore modified modes
(setq *error* olderr) ; Restore old *error* handler
(princ)
)

;(defun c:at () (asctxt))
(defun c:asctext () (asctxt))
(princ “\n ASCTEXT loaded.”)
(princ)

(defun C:TBLIN ()

;;Select file using a dialog box.
(setq RpFileName
(getfiled “Select file to incorporate” “/acad/support/” “txt” 8)
)
;;Open the file.
(setq FileNum (open RpFileName “r”))

;;Test for an empty file.
(setq LineFile (read-line FileNum))

;;Getting data to Autocad.
(while (/= LineFile nil)
(setq LineFile (read-line FileNum)
(princ LineFile)
)
)
)

Legend AutoLisp

(defun C:LEGEND ()

(prompt “\nBuilding legend list…\n”)
;Set variable to get the first element of table.
(setq Frst T)
(setq Counter 0)
(setq CountBlk 0)

;Get all block names.
(while (setq Tbdata (tblnext “BLOCK” Frst))
(setq Bname (dxf 2 Tbdata))

;print all block names.
(if (/= Bname nil)
;Discard dimension blocks.
(if (/= “*” (substr Bname 1 1))
;Call function.
(FindTag Bname)
);end if
);end if
(setq Frst nil)
);while end
);end defun

(defun FindTag (InBlkName)
;debug line
;(princ (strcat InBlkName “\n”))

;Check for blocks in drawing.
(if (= InBlkName “ITEMTAG”)
(setq CountBlk (+ CountBlk 1))
;else
(progn
;Call function to get nested blocks.
(setq Blklist (blist InBlkName))

;Call function Show Elements.
(ShowElem Blklist)
);end progn
);end if
);end defun

(defun ShowElem (ElemList)
(foreach ChkEnt Elemlist
(progn
(setq DebugName (dxf 2 ChkEnt))
(if (/= DebugName nil)
(if (= DebugName “ITEMTAG”)
(progn
;Extract Itemtag’s text.
(setq TxtList (GetTagName ChkEnt))
;Print in file.
(CreateFile TxtList)
);end progn
);end if
);end if
);end progn
);end foreach
);end defun

;This function get a text inside a block with attributes.
;Once the ItemTag block has been found look at its sub-entities
;searching for an attrib entity with the data text.

(defun GetTagName (HeadEnt)
;Show head entity.
(setq HeadData (entget (dxf -1 HeadEnt)))

;Get from Head Entity data the first Sub-entity.
(setq PrimCode (entnext (dxf -1 HeadData)))
(setq PrimData (entget PrimCode))
(setq BlkText (dxf 1 PrimData))
(princ (strcat BlkText “\n”))

;Add itemtag text to list.
(setq TagTextList
(append TagTextList
(list BlkText)
);end append
);end setq

;Return a list with text.
TagTextList
);end defun

; DXF returns property of entered code.
(defun dxf (code elist)
(cdr (assoc code elist))
)

; BLIST returns a list of the block head and subentity data
; lists for the specified block name.
(defun blist (blname / tblist tdata ename)
(setq tblist (list (setq tdata (tblsearch “block” blname)))
;set ename to first sub-entity.
ename (dxf -2 tdata)
);end setq
(while
(progn
(setq tblist
(append tblist
(list (entget ename))
);end append
);end setq
(setq ename (entnext ename))
);end progn
);wend
;send back the list.
tblist
);end defun

(defun CreateFile (ListToWrite)
(princ (getvar “Dwgname”))
);end defun

AutoCAD lisp Shortcuts

;;; SHORCUTS BY V. MENDEZ

 

;;; SHORCUTS BY V. MENDEZ

;SHOWS THE BLOCK NAME OF AN ENTITY
(DEFUN C:BB(/ bb name)
(SETQ bb(entget(car(entsel))))
(SETQ name (cdr(assoc 2 bb)))
(SETQ name (strcat “Block Name… ” name))
(ALERT name)
(princ)
)

;SHOWS THE LAYER NAME OF AN ENTITY
(DEFUN C:CC(/ bb name)
(SETQ bb(entget(car(entsel))))
(SETQ name (cdr(assoc 8 bb)))
(SETQ name (strcat “Entity Layer… ” name))
(ALERT name)
(princ)
)

;DDINSERT
(DEFUN C:DDI ()
(COMMAND “DDINSERT”))

;CHANGE
(DEFUN C:CH ()
(COMMAND “CHANGE”))

;COPY
(DEFUN C:CO ()
(COMMAND “COPY” “SI” “AUTO” PAUSE PAUSE))

; PEW [SET WIDTH OF A POLYLINE TO ZERO]
(DEFUN C:PEW ()
(COMMAND “PEDIT” PAUSE “W” “0” “”))

(DEFUN C:SCINS ()
(COMMAND “SCALE” “SI” “auto” PAUSE PAUSE “INS” PAUSE SF))

; EXTEND TO SELECTED OBJECTS BY AUTO ONLY TWO TIMES.
(DEFUN C:EXT ()
(COMMAND “EXTEND” “SI” “AUTO” PAUSE PAUSE PAUSE PAUSE “”))

; BREAK SELECTED OBJECT AT INTERSECTION.
(DEFUN C:BR ()
(COMMAND “BREAK” PAUSE “F” “INT” PAUSE “INT”))

; BREAK at the selected poit SELECTED OBJECT AT INTERSECTION.
(DEFUN C:BRA ()
(COMMAND “BREAK” PAUSE “F” “INT” PAUSE “@”))

; CHANGE LAYER, BUT MUST GIVE LAYER NAME.
(DEFUN C:CLA ()
(COMMAND “CHANGE” “SI” “AUTO” PAUSE PAUSE “P” “LA”))

; FILLET CROSSING
(DEFUN C:FC ()
(COMMAND “FILLET” “C” PAUSE PAUSE))

; MIRROR
(DEFUN C:MI ()
(COMMAND “MIRROR”))

; OFFSET
(DEFUN C:OF ()
(COMMAND “OFFSET”))

; STRETCH “CROSSING”
(DEFUN C:ST ()
(COMMAND “STRETCH” “C” PAUSE PAUSE))

; ZOOM WINDOW
(DEFUN C:ZW ()
(COMMAND “‘ZOOM” “W” PAUSE PAUSE))

; ZOOM PREVIOUS
(DEFUN C:ZP ()
(COMMAND “‘ZOOM” “P”))

; ZOOM EXTENTS
(DEFUN C:ZE ()
(COMMAND “ZOOM” “E”))

; ZOOM DYNAMIC
(DEFUN C:ZD ()
(COMMAND “‘ZOOM” “D”))

; CHANGE
(DEFUN C:CH ()
(COMMAND “CHANGE” “AUTO”))

; TRIM “SI” “AUTO”
(DEFUN C:TRA ()
(COMMAND “TRIM” “SI” “AUTO”))

; TRIM FENCE
(DEFUN C:TRF ()
(COMMAND “TRIM” “AUTO” PAUSE PAUSE “” “F” ))

; EXTEND
(DEFUN C:EXT ()
(COMMAND “EXTEND” ))

; EXPLODE
(DEFUN C:EX ()
(COMMAND “EXPLODE” ))

; MOVE
(DEFUN C:MO ()
(COMMAND “MOVE” “AUTO”))

; ROTATE
(DEFUN C:RO ()
(COMMAND “ROTATE” “AUTO”))

;;; LISP ROUTINES

(DEFUN C:VSNAP (/)

; Sept. 25,97. By V.Mendez (c) r.1.0
; This function centers an object between two parallel lines.

(SETVAR “CMDECHO” 0)
(COMMAND “OSNAP” “NONE”)
(COMMAND “OSNAP” “CEN,MID,END”)
(SETQ SelObj (ENTSEL “\nSelect Object [cen,mid,end] : “)
BPoint (GETPOINT “\nBase Point [cen,mid,end] : “)
)
(COMMAND “OSNAP” “NEA”)
(SETQ Point1 (GETPOINT “\nFirst Point [nearest] : “))
(COMMAND “OSNAP” “PER”)
(SETQ Point2 (GETPOINT Point1 “\nSecond Point [Perpendicular] : “))
(SETQ X1 (CAR Point1)
Y1 (CADR Point1)
Z1 (CADDR Point1)
)
(SETQ X2 (CAR Point2)
Y2 (CADR Point2)
Z2 (CADDR Point2)
)
(SETQ XMid (/ (+ X2 X1) 2)
YMid (/ (+ Y2 Y1) 2)
ZMid (/ (+ Z2 Z1) 2)
)
(SETQ XObj (CAR BPoint)
YObj (CADR BPoint)
ZObj (CADDR BPoint)
)
(IF (AND (= X1 X2) (= Z1 Z2)) (COMMAND “MOVE” SelObj “” BPoint (LIST X1 YMid 0)) )
(IF (AND (= Y1 Y2) (= Z1 Z2)) (COMMAND “MOVE” SelObj “” BPoint (LIST XMid Y1 0)) )
(COMMAND “OSNAP” “NONE”)
(SETVAR “CMDECHO” 1)
)

(DEFUN C:RECT (/ p1 p2)
(setvar “cmdecho” 0)
(if (and
(setq p1 (getpoint “\nFirst corner: “))
(setq p2 (getcorner p1 “\nOther corner: “))
)
(if A_LINE
(command “.line” p1
(list (car p1) (cadr p2) (caddr p1))
(list (car p2) (cadr p2) (caddr p1))
(list (car p2) (cadr p1) (caddr p1)) “c”
)
(command “.pline” p1
(list (car p1) (cadr p2) (caddr p1))
(list (car p2) (cadr p2) (caddr p1))
(list (car p2) (cadr p1) (caddr p1)) “c”
)
)
)
(princ)
)

(DEFUN C:TEI (/ ) ;a a1 a2 nam ins bk1)
(setvar “regenmode” 0)
(setvar “cmdecho” 0)
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa2(cdr(assoc 8 inf)))

(command “explode” a )
(setq bk1 (ssget “p”))

(setq nooo 0)
(repeat (sslength bk1)
(setq capa(ssname bk1 nooo))
(setq asso(cdr(assoc 8(entget capa))))
(SETQ BLO(CDR(ASSOC 2(ENTGET CAPA))))
(setq loc(cdr(assoc 10(entget capa))))
(setq ref(cdr(assoc 0(entget CAPA))))
(IF (OR
(= “PTAGM” BLO)(= “ETAGM” BLO)
(= “EPTAGM” BLO)
(= “ERITAG” BLO)(= “PRITAG” BLO))
(COMMAND “SCALE” CAPA “” LOC “1.6”)
)
(setq nooo(+ nooo 1))
);repeat
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )

(setvar “regenmode” 1)
(princ)
)

; CHANGE LAYER ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:CHGLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in the desired layer:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ ENAME2 (ENTSEL “\nSelect entity to change to new layer:”))
(SETQ ELIST2 (ENTGET (CAR ENAME2)))
(SETQ NEWLIST2
(SUBST LYRPAIR (ASSOC 8 ELIST2) ELIST2)
)
(ENTMOD NEWLIST2)
)

; SET TO LAYER ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:SETLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in the desired layer:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ CULYR (CDR LYRPAIR))
(COMMAND “LAYER” “SET” CULYR “” “”)
)

; CHANGE THE SIZE OF TEXT TO A PREVIOUS SETQ SZ
(DEFUN C:TXTSZ ()
(COMMAND “CHANGE” “SI” PAUSE “” “” “” SZ “” “”)
)

; TURN LAYER OFF ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:OFFLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in layer to be turned off:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ LYR (CDR LYRPAIR))
(COMMAND “LAYER” “OFF” LYR “” “”)
)

; CULA CHANGES OBJECTS TO THE CURRENT LAYER
(DEFUN C:CULA ()
(COMMAND “CHANGE” “SI” “AUTO” PAUSE PAUSE “P” “LA” CULYR “”)
)

;MOTXT MOVES TEXT FROM INSERTION POINT TO INSERTION POINT FOR REFERENCE
(DEFUN C:MOINT ()
(COMMAND “MOVE” “SI” “AUTO” PAUSE PAUSE “INT” PAUSE “INT” PAUSE)
)

;MOTXT MOVES TEXT FROM INSERTION POINT TO INSERTION POINT FOR REFERENCE
(DEFUN C:MOINS ()
(COMMAND “MOVE” “SI” “AUTO” PAUSE PAUSE “INS” PAUSE “INS” PAUSE)
)

;DDA FOR DDATTE ATTRIBUTE EDIT DIALOG
(DEFUN C:DA ()
(COMMAND “DDATTE”)
)

;DDE FOR DDEDIT TEXT EDITING DIALOG
(DEFUN C:DDE ()
(COMMAND “DDEDIT”)
)

;DDL FOR DDLMODES LAYER DIALOG
(DEFUN C:DDL ()
(COMMAND “DDLMODES”))

;SCA SCALE FACTOR FOR CENTER
(DEFUN C:SCEN ()
(COMMAND “SCALE” “SI” “AUTO” PAUSE PAUSE “CEN” PAUSE SF)
)

; DIMENSION HORIZONTAL
(DEFUN C:DMH()
(COMMAND “OSNAP” “END,INT,CEN,NODE”)
(COMMAND “DIM” “HOR” PAUSE PAUSE PAUSE “” “EXIT”)
(COMMAND “OSNAP” “NONE”)
)

; DIMENSION VERTICAL
(DEFUN C:DMV()
(COMMAND “OSNAP” “END,INT,CEN,NODE”)
(COMMAND “DIM” “VER” PAUSE PAUSE PAUSE “” “EXIT”)
(COMMAND “OSNAP” “NONE”)
)

;;; -*- Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988
;;; not-so-tiny two pick door program

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: DOORX.LSP Copyright (C) Benjamin Olasov 1988 All Rights Reserved ;;;
;;; Research/ commercial inquiries: ;;;
;;; Benjamin Olasov 310 Riverside Drive New York, NY 10025 ;;;
;;; PH (212) 678-5473 ;;;
;;; MCI-MAIL: 344-4003 ;;;
;;; CompuServe: 71450,3313 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is provided ‘as is’ without warranty of any kind, either
;; expressed or implied, including, but not limited to the implied
;; warranties of merchantability and fitness for a particular purpose.
;; The entire risk as to the quality and performance of the program is
;; with the user. Should the program prove defective, the user assumes
;; the entire cost of all necessary servicing, repair or correction.
;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.

(gc)
(vmon)
(princ “\nPlease wait- loading.\n”)

(DEFUN C:DOOR (/ HP1 HP2 DWIDTH SP1 SP2 C-LAY BOX LINE1 LINE2)
(SETVAR “CMDECHO” 0)
(SETVAR “COORDS” 2)
(SETVAR “OSMODE” 256)
(SETQ HP1 (GETPOINT “\nHinge pt: “)
HP1 (OSNAP HP1 “NEAR”)
SP1 (GETPOINT HP1 “\nSwing pt: “)
SP1 (OSNAP SP1 “NEAR”)
DWIDTH (DISTANCE HP1 SP1)
C-LAY (GETVAR “CLAYER”)
BOX (SSGET “C” (LIST (- (CAR HP1) 12.0) (- (CADR HP1) 12.0))
(LIST (+ (CAR HP1) 12.0) (+ (CADR HP1) 12.0))))
(IF (AND BOX (SETQ LINE1 (ENTGET (SSNAME (SSGET HP1) 0))))
(PROGN (SSDEL (CDR (ASSOC -1 LINE1)) BOX) ;; remove first line from box
(FOREACH ENT (SS2ELIST BOX)
(IF (OR (/= (CDR (ASSOC 8 ENT))
(CDR (ASSOC 8 LINE1)))
(/= (CDR (ASSOC 0 ENT)) “LINE”)
(NOT (PARALLEL ENT LINE1)))
(SSDEL (CDR (ASSOC -1 ENT)) BOX)))
(SETVAR “OSMODE” 0)
(IF (> (SSLENGTH BOX) 0) ;; look in the box
(PROGN (SETQ LINE2 (ENTGET (SSNAME BOX 0))
HP2 (INTERS (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))
HP1
(POLAR HP1 (IF (> PI (ANGLE HP1 SP1))
(- (ANGLE HP1 SP1) (/ PI 2.0))
(+ (ANGLE HP1 SP1) (/ PI 2.0)))
(DISTANCE HP1 SP1)) nil))
(COMMAND “LAYER” “S” (CDR (ASSOC 8 LINE1)) “”)
(SETQ SP2 (POLAR HP2 (ANGLE HP1 SP1) DWIDTH)
P5 (POLAR HP1 (ANGLE HP2 HP1) DWIDTH))
(COMMAND “BREAK” HP1 SP1)
(COMMAND “BREAK” HP2 SP2)
(COMMAND “LINE” HP1 HP2 “”)
(COMMAND “LINE” SP1 SP2 “”)
(COMMAND “LINE” HP1 P5 “”)
(COMMAND “ARC” SP1 “E” P5 “D” (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
(COMMAND “LAYER” “S” C-LAY “”)))))
(PRINC))

;; convert a selection set to a list of entity lists
(DEFUN SS2ELIST (SS / ENTLIST COUNTER)
(SETQ COUNTER 0)
(REPEAT (SSLENGTH SS)
(PROGN (SETQ ENTLIST (CONS (ENTGET (SSNAME SS COUNTER)) ENTLIST))
(SETQ COUNTER (1+ COUNTER)))) ENTLIST)

;; takes 2 e-lists as arguments
(DEFUN PARALLEL (L1 L2)
(OR (~= (ANGLE (CDR (ASSOC 10 L1)) (CDR (ASSOC 11 L1)))
(ANGLE (CDR (ASSOC 10 L2)) (CDR (ASSOC 11 L2)))
(/ PI 180.0)) ;; 1 rad tolerance
(~= (ANGLE (CDR (ASSOC 11 L1)) (CDR (ASSOC 10 L1)))
(ANGLE (CDR (ASSOC 10 L2)) (CDR (ASSOC 11 L2)))
(/ PI 180.0))))

(DEFUN ~= (ACT_VAL TEST_VAL TOL) ;;fuzzy equality
(AND (<= ACT_VAL (+ TEST_VAL TOL))
(>= ACT_VAL (- TEST_VAL TOL))))

;;; ssx.lsp
;;; Copyright (C) 1990 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED “AS IS” WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Larry Knott Version 2.0 7/18/88
;;; Carl Bethea & Jan S. Yoder Version 3.0
;;; Enhancements to (ssx).
;;; 15 March 1990
;;;
;;;————————————————————————–;
;;; DESCRIPTION
;;; SSX.LSP
;;;
;;; “(SSX)” – Easy SSGET filter routine.
;;;
;;; Creates a selection set. Either type “SSX” at the “Command:” prompt
;;; to create a “previous” selection set or type “(SSX)” in response to
;;; any “Select objects:” prompt. You may use the functions “(A)” to add
;;; entities and “(R)” to remove entities from a selection set during
;;; object selection. More than one filter criteria can be used at a
;;; time.
;;;
;;; SSX returns a selection set either exactly like a selected
;;; entity or, by adjusting the filter list, similar to it.
;;;
;;; The initial prompt is this:
;;;
;;; Command: ssx
;;; Select object/<None>: (RETURN)
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; Pressing RETURN at the initial prompt gives you a null selection
;;; mechanism just as (ssx) did in Release 10, but you may select an
;;; entity if you desire. If you do so, then the list of valid types
;;; allowed by (ssget “x”) are presented on the command line.
;;;
;;; Select object/<None>: (a LINE selected)
;;; Filter: ((0 . “LINE”) (8 . “0”) (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; At this point any of these filters may be removed by selecting the
;;; option keyword, then pressing RETURN.
;;;
;;; >>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;; Filter: ((0 . “LINE”) (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; If an item exists in the filter list and you elect to add a new item,
;;; the old value is overwritten by the new value, as you can have only
;;; one of each type in a single (ssget “x”) call.
;;;
;;;————————————————————————–;
;;;
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named “ent”.
;;;
;;; ssx_fe == SSX_Find_Entity
;;;
(defun ssx_fe (/ x data fltr ent)
(setq ent (car (entsel “\nSelect object/<None>: “)))
(if ent
(progn
(setq data (entget ent))
(foreach x ‘(0 2 6 7 8 39 62 66 210) ; do not include 38
(if (assoc x data)
(setq fltr
(cons (assoc x data) fltr)
)
)
)
(reverse fltr)
)
)
)
;;;
;;; Remove “element” from “alist”.
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
(append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
)
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s) ; If an error (such as CTRL-C) occurs
; while this command is active…
(if (/= s “Function cancelled”)
(princ (strcat “\nError: ” s))
)
(if olderr (setq *error* olderr)) ; Restore old *error* handler
(princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr)
(gc) ; close any sel-sets
(setq olderr *error*
*error* ssx_er
)
(setq fltr (ssx_fe))
(ssx_gf fltr)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
(while
(progn
(cond (f1 (prompt “\nFilter: “) (prin1 f1)))
(initget
“Block Color Entity Flag LAyer LType Pick Style Thickness Vector”)
(setq t1 (getkword (strcat
“\n>>Block name/Color/Entity/Flag/”
“LAyer/LType/Pick/Style/Thickness/Vector: “)))
)
(setq t2
(cond
((eq t1 “Block”) 2) ((eq t1 “Color”) 62)
((eq t1 “Entity”) 0) ((eq t1 “LAyer”) 8)
((eq t1 “LType”) 6) ((eq t1 “Style”) 7)
((eq t1 “Thickness”) 39) ((eq t1 “Flag” ) 66)
((eq t1 “Vector”) 210)
(T t1)
)
)
(setq t3
(cond
((= t2 2) (getstring “\n>>Block name to add/<RETURN to remove>: “))
((= t2 62) (initget 4 “?”)
(cond
((or (eq (setq t3 (getint
“\n>>Color number to add/?/<RETURN to remove>: “)) “?”)
(> t3 256))
(ssx_pc) ; Print color values.
nil
)
(T
t3 ; Return t3.
)
)
)
((= t2 0) (getstring “\n>>Entity type to add/<RETURN to remove>: “))
((= t2 8) (getstring “\n>>Layer name to add/<RETURN to remove>: “))
((= t2 6) (getstring “\n>>Linetype name to add/<RETURN to remove>: “))
((= t2 7)
(getstring “\n>>Text style name to add/<RETURN to remove>: “)
)
((= t2 39) (getreal “\n>>Thickness to add/<RETURN to remove>: “))
((= t2 66) (if (assoc 66 f1) nil 1))
((= t2 210)
(getpoint “\n>>Extrusion Vector to add/<RETURN to remove>: “)
)
(T nil)
)
)
(cond
((= t2 “Pick”) (setq f1 (ssx_fe) t2 nil)) ; get entity
((and f1 (assoc t2 f1)) ; already in the list
(if (and t3 (/= t3 “”))
;; Replace with a new value…
(setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
;; Remove it from filter list…
(setq f1 (ssx_re (assoc t2 f1) f1))
)
)
((and t3 (/= t3 “”))
(setq f1 (cons (cons t2 t3) f1))
)
(T nil)
)
)
(if f1 (setq f2 (ssget “x” f1)))
(setq *error* olderr)
(if (and f1 f2)
(progn
(princ (strcat “\n” (itoa (sslength f2)) ” found. “))
f2
)
(progn (princ “\n0 found.”) (prin1))
)
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
(if textpage (textpage) (textscr))
(princ “\n “)
(princ “\n Color number | Standard meaning “)
(princ “\n ________________|____________________”)
(princ “\n | “)
(princ “\n 0 | <BYBLOCK> “)
(princ “\n 1 | Red “)
(princ “\n 2 | Yellow “)
(princ “\n 3 | Green “)
(princ “\n 4 | Cyan “)
(princ “\n 5 | Blue “)
(princ “\n 6 | Magenta “)
(princ “\n 7 | White “)
(princ “\n 8…255 | -Varies- “)
(princ “\n 256 | <BYLAYER> “)
(princ “\n \n\n\n”)
)
;;;
;;; C: function definition.
;;;
(defun c:ssx () (ssx)(princ))
(princ “\n\tType \”ssx\” at a Command: prompt or “)
(princ “\n\t(ssx) at any object selection prompt. “)
(princ)

 

Block AutoLISP Shortcuts

;;; SHORCUTS BY V. MENDEZ

;SHOWS THE BLOCK NAME OF AN ENTITY
(DEFUN C:BB(/ bb name)
(SETQ bb(entget(car(entsel))))
(SETQ name (cdr(assoc 2 bb)))
(SETQ name (strcat “Block Name… ” name))
(ALERT name)
(princ)
)

;SHOWS THE LAYER NAME OF AN ENTITY
(DEFUN C:CC(/ bb name)
(SETQ bb(entget(car(entsel))))
(SETQ name (cdr(assoc 8 bb)))
(SETQ name (strcat “Entity Layer… ” name))
(ALERT name)
(princ)
)

;DDINSERT
(DEFUN C:DDI ()
(COMMAND “DDINSERT”))

;CHANGE
(DEFUN C:CH ()
(COMMAND “CHANGE”))

;COPY
(DEFUN C:CO ()
(COMMAND “COPY” “SI” “AUTO” PAUSE PAUSE))

; PEW [SET WIDTH OF A POLYLINE TO ZERO]
(DEFUN C:PEW ()
(COMMAND “PEDIT” PAUSE “W” “0” “”))

(DEFUN C:SCINS ()
(COMMAND “SCALE” “SI” “auto” PAUSE PAUSE “INS” PAUSE SF))

; EXTEND TO SELECTED OBJECTS BY AUTO ONLY TWO TIMES.
(DEFUN C:EXT ()
(COMMAND “EXTEND” “SI” “AUTO” PAUSE PAUSE PAUSE PAUSE “”))

; BREAK SELECTED OBJECT AT INTERSECTION.
(DEFUN C:BR ()
(COMMAND “BREAK” PAUSE “F” “INT” PAUSE “INT”))

; BREAK at the selected poit SELECTED OBJECT AT INTERSECTION.
(DEFUN C:BRA ()
(COMMAND “BREAK” PAUSE “F” “INT” PAUSE “@”))

; CHANGE LAYER, BUT MUST GIVE LAYER NAME.
(DEFUN C:CLA ()
(COMMAND “CHANGE” “SI” “AUTO” PAUSE PAUSE “P” “LA”))

; FILLET CROSSING
(DEFUN C:FC ()
(COMMAND “FILLET” “C” PAUSE PAUSE))

; MIRROR
(DEFUN C:MI ()
(COMMAND “MIRROR”))

; OFFSET
(DEFUN C:OF ()
(COMMAND “OFFSET”))

; STRETCH “CROSSING”
(DEFUN C:ST ()
(COMMAND “STRETCH” “C” PAUSE PAUSE))

; ZOOM WINDOW
(DEFUN C:ZW ()
(COMMAND “‘ZOOM” “W” PAUSE PAUSE))

; ZOOM PREVIOUS
(DEFUN C:ZP ()
(COMMAND “‘ZOOM” “P”))

; ZOOM EXTENTS
(DEFUN C:ZE ()
(COMMAND “ZOOM” “E”))

; ZOOM DYNAMIC
(DEFUN C:ZD ()
(COMMAND “‘ZOOM” “D”))

; CHANGE
(DEFUN C:CH ()
(COMMAND “CHANGE” “AUTO”))

; TRIM “SI” “AUTO”
(DEFUN C:TRA ()
(COMMAND “TRIM” “SI” “AUTO”))

; TRIM FENCE
(DEFUN C:TRF ()
(COMMAND “TRIM” “AUTO” PAUSE PAUSE “” “F” ))

; EXTEND
(DEFUN C:EXT ()
(COMMAND “EXTEND” ))

; EXPLODE
(DEFUN C:EX ()
(COMMAND “EXPLODE” ))

; MOVE
(DEFUN C:MO ()
(COMMAND “MOVE” “AUTO”))

; ROTATE
(DEFUN C:RO ()
(COMMAND “ROTATE” “AUTO”))

;;; LISP ROUTINES

(DEFUN C:VSNAP (/)

; Sept. 25,97. By V.Mendez (c) r.1.0
; This function centers an object between two parallel lines.

(SETVAR “CMDECHO” 0)
(COMMAND “OSNAP” “NONE”)
(COMMAND “OSNAP” “CEN,MID,END”)
(SETQ SelObj (ENTSEL “\nSelect Object [cen,mid,end] : “)
BPoint (GETPOINT “\nBase Point [cen,mid,end] : “)
)
(COMMAND “OSNAP” “NEA”)
(SETQ Point1 (GETPOINT “\nFirst Point [nearest] : “))
(COMMAND “OSNAP” “PER”)
(SETQ Point2 (GETPOINT Point1 “\nSecond Point [Perpendicular] : “))
(SETQ X1 (CAR Point1)
Y1 (CADR Point1)
Z1 (CADDR Point1)
)
(SETQ X2 (CAR Point2)
Y2 (CADR Point2)
Z2 (CADDR Point2)
)
(SETQ XMid (/ (+ X2 X1) 2)
YMid (/ (+ Y2 Y1) 2)
ZMid (/ (+ Z2 Z1) 2)
)
(SETQ XObj (CAR BPoint)
YObj (CADR BPoint)
ZObj (CADDR BPoint)
)
(IF (AND (= X1 X2) (= Z1 Z2)) (COMMAND “MOVE” SelObj “” BPoint (LIST X1 YMid 0)) )
(IF (AND (= Y1 Y2) (= Z1 Z2)) (COMMAND “MOVE” SelObj “” BPoint (LIST XMid Y1 0)) )
(COMMAND “OSNAP” “NONE”)
(SETVAR “CMDECHO” 1)
)

(DEFUN C:RECT (/ p1 p2)
(setvar “cmdecho” 0)
(if (and
(setq p1 (getpoint “\nFirst corner: “))
(setq p2 (getcorner p1 “\nOther corner: “))
)
(if A_LINE
(command “.line” p1
(list (car p1) (cadr p2) (caddr p1))
(list (car p2) (cadr p2) (caddr p1))
(list (car p2) (cadr p1) (caddr p1)) “c”
)
(command “.pline” p1
(list (car p1) (cadr p2) (caddr p1))
(list (car p2) (cadr p2) (caddr p1))
(list (car p2) (cadr p1) (caddr p1)) “c”
)
)
)
(princ)
)

(DEFUN C:TEI (/ ) ;a a1 a2 nam ins bk1)
(setvar “regenmode” 0)
(setvar “cmdecho” 0)
(SETQ A(ENTSEL))
(SETQ A1(CAR A))
(SETQ a2 (car(cdr a)))
(setq inf (entget a1))
(setq nam(cdr(assoc 2 inf)))
(setq ins(cdr(assoc 10 inf)))
(setq capa2(cdr(assoc 8 inf)))

(command “explode” a )
(setq bk1 (ssget “p”))

(setq nooo 0)
(repeat (sslength bk1)
(setq capa(ssname bk1 nooo))
(setq asso(cdr(assoc 8(entget capa))))
(SETQ BLO(CDR(ASSOC 2(ENTGET CAPA))))
(setq loc(cdr(assoc 10(entget capa))))
(setq ref(cdr(assoc 0(entget CAPA))))
(IF (OR
(= “PTAGM” BLO)(= “ETAGM” BLO)
(= “EPTAGM” BLO)
(= “ERITAG” BLO)(= “PRITAG” BLO))
(COMMAND “SCALE” CAPA “” LOC “1.6”)
)
(setq nooo(+ nooo 1))
);repeat
(command “block” nam “y” ins bk1 “”)
(command “insert” nam ins “” “” “”)
(command “change” “l” “” “p” “la” capa2 “” )

(setvar “regenmode” 1)
(princ)
)

; CHANGE LAYER ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:CHGLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in the desired layer:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ ENAME2 (ENTSEL “\nSelect entity to change to new layer:”))
(SETQ ELIST2 (ENTGET (CAR ENAME2)))
(SETQ NEWLIST2
(SUBST LYRPAIR (ASSOC 8 ELIST2) ELIST2)
)
(ENTMOD NEWLIST2)
)

; SET TO LAYER ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:SETLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in the desired layer:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ CULYR (CDR LYRPAIR))
(COMMAND “LAYER” “SET” CULYR “” “”)
)

; CHANGE THE SIZE OF TEXT TO A PREVIOUS SETQ SZ
(DEFUN C:TXTSZ ()
(COMMAND “CHANGE” “SI” PAUSE “” “” “” SZ “” “”)
)

; TURN LAYER OFF ROUTINE, FOR SINGLE SELECTION.
(DEFUN C:OFFLA ()
(SETQ ENAME (ENTSEL “\nSelect an entity in layer to be turned off:”))
(SETQ ELIST (ENTGET (CAR ENAME)))
(SETQ LYRPAIR (ASSOC 8 ELIST))
(SETQ LYR (CDR LYRPAIR))
(COMMAND “LAYER” “OFF” LYR “” “”)
)

; CULA CHANGES OBJECTS TO THE CURRENT LAYER
(DEFUN C:CULA ()
(COMMAND “CHANGE” “SI” “AUTO” PAUSE PAUSE “P” “LA” CULYR “”)
)

;MOTXT MOVES TEXT FROM INSERTION POINT TO INSERTION POINT FOR REFERENCE
(DEFUN C:MOINT ()
(COMMAND “MOVE” “SI” “AUTO” PAUSE PAUSE “INT” PAUSE “INT” PAUSE)
)

;MOTXT MOVES TEXT FROM INSERTION POINT TO INSERTION POINT FOR REFERENCE
(DEFUN C:MOINS ()
(COMMAND “MOVE” “SI” “AUTO” PAUSE PAUSE “INS” PAUSE “INS” PAUSE)
)

;DDA FOR DDATTE ATTRIBUTE EDIT DIALOG
(DEFUN C:DA ()
(COMMAND “DDATTE”)
)

;DDE FOR DDEDIT TEXT EDITING DIALOG
(DEFUN C:DDE ()
(COMMAND “DDEDIT”)
)

;DDL FOR DDLMODES LAYER DIALOG
(DEFUN C:DDL ()
(COMMAND “DDLMODES”))

;SCA SCALE FACTOR FOR CENTER
(DEFUN C:SCEN ()
(COMMAND “SCALE” “SI” “AUTO” PAUSE PAUSE “CEN” PAUSE SF)
)

; DIMENSION HORIZONTAL
(DEFUN C:DMH()
(COMMAND “OSNAP” “END,INT,CEN,NODE”)
(COMMAND “DIM” “HOR” PAUSE PAUSE PAUSE “” “EXIT”)
(COMMAND “OSNAP” “NONE”)
)

; DIMENSION VERTICAL
(DEFUN C:DMV()
(COMMAND “OSNAP” “END,INT,CEN,NODE”)
(COMMAND “DIM” “VER” PAUSE PAUSE PAUSE “” “EXIT”)
(COMMAND “OSNAP” “NONE”)
)

;;; -*- Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988
;;; not-so-tiny two pick door program

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: DOORX.LSP Copyright (C) Benjamin Olasov 1988 All Rights Reserved ;;;
;;; Research/ commercial inquiries: ;;;
;;; Benjamin Olasov 310 Riverside Drive New York, NY 10025 ;;;
;;; PH (212) 678-5473 ;;;
;;; MCI-MAIL: 344-4003 ;;;
;;; CompuServe: 71450,3313 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is provided ‘as is’ without warranty of any kind, either
;; expressed or implied, including, but not limited to the implied
;; warranties of merchantability and fitness for a particular purpose.
;; The entire risk as to the quality and performance of the program is
;; with the user. Should the program prove defective, the user assumes
;; the entire cost of all necessary servicing, repair or correction.
;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.

(gc)
(vmon)
(princ “\nPlease wait- loading.\n”)

(DEFUN C:DOOR (/ HP1 HP2 DWIDTH SP1 SP2 C-LAY BOX LINE1 LINE2)
(SETVAR “CMDECHO” 0)
(SETVAR “COORDS” 2)
(SETVAR “OSMODE” 256)
(SETQ HP1 (GETPOINT “\nHinge pt: “)
HP1 (OSNAP HP1 “NEAR”)
SP1 (GETPOINT HP1 “\nSwing pt: “)
SP1 (OSNAP SP1 “NEAR”)
DWIDTH (DISTANCE HP1 SP1)
C-LAY (GETVAR “CLAYER”)
BOX (SSGET “C” (LIST (- (CAR HP1) 12.0) (- (CADR HP1) 12.0))
(LIST (+ (CAR HP1) 12.0) (+ (CADR HP1) 12.0))))
(IF (AND BOX (SETQ LINE1 (ENTGET (SSNAME (SSGET HP1) 0))))
(PROGN (SSDEL (CDR (ASSOC -1 LINE1)) BOX) ;; remove first line from box
(FOREACH ENT (SS2ELIST BOX)
(IF (OR (/= (CDR (ASSOC 8 ENT))
(CDR (ASSOC 8 LINE1)))
(/= (CDR (ASSOC 0 ENT)) “LINE”)
(NOT (PARALLEL ENT LINE1)))
(SSDEL (CDR (ASSOC -1 ENT)) BOX)))
(SETVAR “OSMODE” 0)
(IF (> (SSLENGTH BOX) 0) ;; look in the box
(PROGN (SETQ LINE2 (ENTGET (SSNAME BOX 0))
HP2 (INTERS (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))
HP1
(POLAR HP1 (IF (> PI (ANGLE HP1 SP1))
(- (ANGLE HP1 SP1) (/ PI 2.0))
(+ (ANGLE HP1 SP1) (/ PI 2.0)))
(DISTANCE HP1 SP1)) nil))
(COMMAND “LAYER” “S” (CDR (ASSOC 8 LINE1)) “”)
(SETQ SP2 (POLAR HP2 (ANGLE HP1 SP1) DWIDTH)
P5 (POLAR HP1 (ANGLE HP2 HP1) DWIDTH))
(COMMAND “BREAK” HP1 SP1)
(COMMAND “BREAK” HP2 SP2)
(COMMAND “LINE” HP1 HP2 “”)
(COMMAND “LINE” SP1 SP2 “”)
(COMMAND “LINE” HP1 P5 “”)
(COMMAND “ARC” SP1 “E” P5 “D” (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
(COMMAND “LAYER” “S” C-LAY “”)))))
(PRINC))

;; convert a selection set to a list of entity lists
(DEFUN SS2ELIST (SS / ENTLIST COUNTER)
(SETQ COUNTER 0)
(REPEAT (SSLENGTH SS)
(PROGN (SETQ ENTLIST (CONS (ENTGET (SSNAME SS COUNTER)) ENTLIST))
(SETQ COUNTER (1+ COUNTER)))) ENTLIST)

;; takes 2 e-lists as arguments
(DEFUN PARALLEL (L1 L2)
(OR (~= (ANGLE (CDR (ASSOC 10 L1)) (CDR (ASSOC 11 L1)))
(ANGLE (CDR (ASSOC 10 L2)) (CDR (ASSOC 11 L2)))
(/ PI 180.0)) ;; 1 rad tolerance
(~= (ANGLE (CDR (ASSOC 11 L1)) (CDR (ASSOC 10 L1)))
(ANGLE (CDR (ASSOC 10 L2)) (CDR (ASSOC 11 L2)))
(/ PI 180.0))))

(DEFUN ~= (ACT_VAL TEST_VAL TOL) ;;fuzzy equality
(AND (<= ACT_VAL (+ TEST_VAL TOL))
(>= ACT_VAL (- TEST_VAL TOL))))

;;; ssx.lsp
;;; Copyright (C) 1990 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED “AS IS” WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Larry Knott Version 2.0 7/18/88
;;; Carl Bethea & Jan S. Yoder Version 3.0
;;; Enhancements to (ssx).
;;; 15 March 1990
;;;
;;;————————————————————————–;
;;; DESCRIPTION
;;; SSX.LSP
;;;
;;; “(SSX)” – Easy SSGET filter routine.
;;;
;;; Creates a selection set. Either type “SSX” at the “Command:” prompt
;;; to create a “previous” selection set or type “(SSX)” in response to
;;; any “Select objects:” prompt. You may use the functions “(A)” to add
;;; entities and “(R)” to remove entities from a selection set during
;;; object selection. More than one filter criteria can be used at a
;;; time.
;;;
;;; SSX returns a selection set either exactly like a selected
;;; entity or, by adjusting the filter list, similar to it.
;;;
;;; The initial prompt is this:
;;;
;;; Command: ssx
;;; Select object/<None>: (RETURN)
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; Pressing RETURN at the initial prompt gives you a null selection
;;; mechanism just as (ssx) did in Release 10, but you may select an
;;; entity if you desire. If you do so, then the list of valid types
;;; allowed by (ssget “x”) are presented on the command line.
;;;
;;; Select object/<None>: (a LINE selected)
;;; Filter: ((0 . “LINE”) (8 . “0”) (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; At this point any of these filters may be removed by selecting the
;;; option keyword, then pressing RETURN.
;;;
;;; >>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;; Filter: ((0 . “LINE”) (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;; If an item exists in the filter list and you elect to add a new item,
;;; the old value is overwritten by the new value, as you can have only
;;; one of each type in a single (ssget “x”) call.
;;;
;;;————————————————————————–;
;;;
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named “ent”.
;;;
;;; ssx_fe == SSX_Find_Entity
;;;
(defun ssx_fe (/ x data fltr ent)
(setq ent (car (entsel “\nSelect object/<None>: “)))
(if ent
(progn
(setq data (entget ent))
(foreach x ‘(0 2 6 7 8 39 62 66 210) ; do not include 38
(if (assoc x data)
(setq fltr
(cons (assoc x data) fltr)
)
)
)
(reverse fltr)
)
)
)
;;;
;;; Remove “element” from “alist”.
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
(append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
)
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s) ; If an error (such as CTRL-C) occurs
; while this command is active…
(if (/= s “Function cancelled”)
(princ (strcat “\nError: ” s))
)
(if olderr (setq *error* olderr)) ; Restore old *error* handler
(princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr)
(gc) ; close any sel-sets
(setq olderr *error*
*error* ssx_er
)
(setq fltr (ssx_fe))
(ssx_gf fltr)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
(while
(progn
(cond (f1 (prompt “\nFilter: “) (prin1 f1)))
(initget
“Block Color Entity Flag LAyer LType Pick Style Thickness Vector”)
(setq t1 (getkword (strcat
“\n>>Block name/Color/Entity/Flag/”
“LAyer/LType/Pick/Style/Thickness/Vector: “)))
)
(setq t2
(cond
((eq t1 “Block”) 2) ((eq t1 “Color”) 62)
((eq t1 “Entity”) 0) ((eq t1 “LAyer”) 8)
((eq t1 “LType”) 6) ((eq t1 “Style”) 7)
((eq t1 “Thickness”) 39) ((eq t1 “Flag” ) 66)
((eq t1 “Vector”) 210)
(T t1)
)
)
(setq t3
(cond
((= t2 2) (getstring “\n>>Block name to add/<RETURN to remove>: “))
((= t2 62) (initget 4 “?”)
(cond
((or (eq (setq t3 (getint
“\n>>Color number to add/?/<RETURN to remove>: “)) “?”)
(> t3 256))
(ssx_pc) ; Print color values.
nil
)
(T
t3 ; Return t3.
)
)
)
((= t2 0) (getstring “\n>>Entity type to add/<RETURN to remove>: “))
((= t2 8) (getstring “\n>>Layer name to add/<RETURN to remove>: “))
((= t2 6) (getstring “\n>>Linetype name to add/<RETURN to remove>: “))
((= t2 7)
(getstring “\n>>Text style name to add/<RETURN to remove>: “)
)
((= t2 39) (getreal “\n>>Thickness to add/<RETURN to remove>: “))
((= t2 66) (if (assoc 66 f1) nil 1))
((= t2 210)
(getpoint “\n>>Extrusion Vector to add/<RETURN to remove>: “)
)
(T nil)
)
)
(cond
((= t2 “Pick”) (setq f1 (ssx_fe) t2 nil)) ; get entity
((and f1 (assoc t2 f1)) ; already in the list
(if (and t3 (/= t3 “”))
;; Replace with a new value…
(setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
;; Remove it from filter list…
(setq f1 (ssx_re (assoc t2 f1) f1))
)
)
((and t3 (/= t3 “”))
(setq f1 (cons (cons t2 t3) f1))
)
(T nil)
)
)
(if f1 (setq f2 (ssget “x” f1)))
(setq *error* olderr)
(if (and f1 f2)
(progn
(princ (strcat “\n” (itoa (sslength f2)) ” found. “))
f2
)
(progn (princ “\n0 found.”) (prin1))
)
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
(if textpage (textpage) (textscr))
(princ “\n “)
(princ “\n Color number | Standard meaning “)
(princ “\n ________________|____________________”)
(princ “\n | “)
(princ “\n 0 | <BYBLOCK> “)
(princ “\n 1 | Red “)
(princ “\n 2 | Yellow “)
(princ “\n 3 | Green “)
(princ “\n 4 | Cyan “)
(princ “\n 5 | Blue “)
(princ “\n 6 | Magenta “)
(princ “\n 7 | White “)
(princ “\n 8…255 | -Varies- “)
(princ “\n 256 | <BYLAYER> “)
(princ “\n \n\n\n”)
)
;;;
;;; C: function definition.
;;;
(defun c:ssx () (ssx)(princ))
(princ “\n\tType \”ssx\” at a Command: prompt or “)
(princ “\n\t(ssx) at any object selection prompt. “)
(princ)

Free & Paid Search Engine Rank Checkers

These free and paid tools allow you to;

  • track where your websites rank in the search results for important keywords, and
  • track those trends versus competing sites and/or
  • against your own marketing efforts to better understand the effectiveness of your marketing

Rank Tracker Tools

Free Ranking Checkers

Google Rank Checker Tools

These tools do not use the Google API, especially because Google rendered their API virtually useless unless you have one of their old keys.

  • Free Monitor from Google – downloadable tool from CleverStats which monitors website rankings
  • ParaMeter – scrape Google PageRank values in bulk with this downloadable software. Useful for viewing the PageRank profile of a competing site.
  • Mapelli.info – calculates the % of your site stuck in the Google supplemental index.

Meta Search Engines

  • Myriad Search – shows the search results from all 4 major search engines
  • Zippy.co.uk – similar to above, but with more features

Install a Rank Checker on Your Own Site

  • This zip file can be unzipped and installed on any web server which is PHP enabled. It includes a basic rank checker, an advanced rank cheker, a multi-keyword rank checker, a multi-domain rank checker, and a few other goodies. As Google updates their search results it may break these files…but fixing them should only take a couple minutes for a freelance PHP programmer.

Paid Rank Checking Tools

Tracking where you already rank does not alert you to potential areas of opportunity that you have not yet focused on, but it is easier to rank for keywords related to words you already rank well for than it is to rank for a whole new basket of keywords.

From the Engines

  • Google Webmaster Central – allows you to sign up for Google Sitemaps, shows some crawling errors, and a more complete view of your backlinks. Also shows keywords you rank well for and keywords that send you the most traffic.

Related Categories

image

AutoCAD/MS Access Frontends with SQL Backend Integration

AutoCAD/MS Access Frontends with SQL Backend Integration

Problem: Each Sub-Department at the Utilities Department of the University of Colorado at Boulder have specific requirements for spatial and spatial data and often, there is an overlap of information crucial to these sub-departments; operations, maintenance, management,
etc. Equipment data is stored and maintained in an SQL database with a frontend designed in MS Access. All spatial data is stored in vector based (AutoCAD) drawings. Supervisors and management want to use a frontend interface to access and analyzed spatial and spatial data
easily.

Solution: Design, create, implement and maintain a stable application database that can generate queries based on vector and spatial (text, number date) data. All graphical data are linked with attribute (spatial) data which are managed by a RDBMS. A solution needs to be developed using AutoCAD Map as a frontend with an SQL backend.

Result: Increased in cooperation and communication among departments.
Eliminated redundant spatial and aspatial data. Cleaner PID for all different systems of the Co-Generation plant. A substantial reduction of time used to track parts, quipment manufacturer, model, part number.

Enabled access to information across multiple departments apart from bringing in greater efficiency, speedy decision-making and transparency in the functioning.

Capacity Factor Estimator


Capacity Factor Estimator

Problem: Management needs to determine whether to buy electricity
or gas, when gas prices are low. An Xcel Energy contract establishes several parameters under which electricity will be bought from Utilities plant. There is no tool to perform a Cost-Benefit analysis into the
future.

Solution: This computer program evaluates the cost/benefit of selling electricity to public service vs. producing it. It is based on several intrinsic equations (from contract) that consider 12 month rolling calculations projected to the future.

Result: A simulation through June 05, using zero as capacity factor for one out of six months rolling average of 35%, shows another inconsistency in contract to be reviewed by Xcel energy.

Dearator Tank

This invention is directed to a unique segmented plate and associated plate assembly technique, adapted for use where access is limited to an area/chamber within which the plate is to be secured and employed for use in connection with an enclosure.

Patent Application No. 10/643,358

Problem: Management needs to determine whether to buy electricity or gas, when gas prices are low. An Xcel Energy contract establishes several parameters under which electricity will be bought from Utilities
plant. There is no tool to perform a Cost-Benefit analysis into the future.

Solution: This computer program evaluates the cost/benefit of selling electricity to public service vs. producing it. It is based on several intrinsic equations (from contract) that consider 12 month rolling calculations projected to the future.

Result: A simulation through June 05, using zero as capacity factor for one out of six months rolling average of 35%, shows another inconsistency in contract to be reviewed by Xcel energy.

read more …

Hard Disk Redesign

The redesign of a hard disk, currently in production, is a study to determine if it will ultimately increase the profit margin of a product. The two ways redesign will affect the profit margin is
lower the overall material cost and increase the production capability of the product.

Learn more at portfolio_harddisk