Code:
;;; OEFFNEN.LSP
;;; VERSION 1.2
;;; Pgme zum Öffnen von Blöcken und Xref's aus einer Zeichnung heraus.
;;; Kommandos: XOPEN - Öffnet Xref - DWG's
;;; BOPEN - Öffnet Block - DWG's;;; Für Acad-Releases ab Acad2000
;;; Wenn SDI = 1 wird eine weiter AutoCAD Sitzung geöffnet
;;; Wenn SDI = 0 wird der Block / das XREF in einem weiteren Dokumentenfenster geöffnet
;;; Erforderliche Dateien:
;;; DOSLIB 5.0 oder höher [www.mcneel.com] - Freeware
;;; AXOPEN.VLX -> eine mit VisualLisp kompilierte Version von
;;; folgendem Source-Code:
;;; Source Beginn
;;;(defun AXOPEN (DOCNAME)
;;; (if (> (getvar "sdi") 0)
;;; (progn (setvar "cmdecho" 0)
;;; (command "_.open" DOCNAME)
;;; (setvar "cmdecho" 1)
;;; )
;;; (vla-activate
;;; (vla-open (vla-get-documents (vlax-get-acad-object))
;;; DOCNAME
;;; )
;;; )
;;; )
;;; (princ)
;;; )
;;;(vl-doc-export 'axOpen)
;;; Source Ende
;;; Die kompilierte Version ist notwendig, da Acad zwischen den Dokumenten mit
;;; unterschiedlichen Namespaces arbeitet. Ohne diese geht's nicht.
;;; Die Dateien des Doslib und die AXOPEN.VLX müssen im AutoCAD-Suchpfad zu finden sein
;;; Bei Fragen:
;;; marc.scherer@zvo.com
;;; Have fun.
(if (not (member "doslib2k.arx" (arx))) ;_ ist doslib2K geladen?
(progn
(setq FND (findfile "doslib2k.arx")) ;_ nein? Dann finde es
(if FND ;_ wenn gefunden, lade es
(if (eq (arxload FND "err") "err") ;_ Fehler beim laden?
(alert
(strcat "\nKonnte \"doslib2k.arx\" finden, aber nicht laden."
"\nFunktionen nicht ausführbar."
) ;_ end of strcat
) ;_ end of alert
) ;_ end of if
(alert
(strcat
"\nKonnte \"doslib2k.arx\" nicht finden.\nFunktionen nicht ausführbar."
"\nDownload der \"doslib2k.arx\" von \"www.mcneel.com\""
"\nKopiere bitte danach die \"DOS_LIB\" Daten in den Acad-Suchpfad."
) ;_ end of strcat
) ;_ end of alert
) ;_ end if
) ;_ end progn
(princ)
) ;_ end of if
(defun C:XOPEN (/ SEL-XREF XREF-LST)
(setq XREF-LST (VON-TABLE 6)) ;_ Liste erstellen, nur Xref's
(if (not XREF-LST)
(alert
"\nKeine XREF's in aktueller Zeichnung definiert! Funktionsende."
) ;_ end of princ
(progn
(setq SEL-XREF (dos_listbox
"XREF's in aktueller Zeichnung"
"Wähle zu öffnendes XREF..."
XREF-LST
) ;_ end of dos_listbox
) ;_ end of setq
(cond
((not SEL-XREF)
(alert "\nKein XREF zum Öffnen ausgewählt! Funktionsende.")
)
((= (findfile
(cdr (assoc 1 (entget (tblobjname "BLOCK" SEL-XREF))))
) ;_ end of findfile
NIL
) ;_ end of =
(alert
(strcat
"Das XREF: \""
(cdr (assoc 1 (entget (tblobjname "BLOCK" SEL-XREF))))
"\" konnte nicht gefunden werden."
"\nDer o.g. Pfad ist auf DIESEM Rechner nicht bekannt."
) ;_ end of strcat
) ;_ end of alert
)
(t
(OPEN-RESSOURCE
(cdr (assoc 1 (entget (tblobjname "BLOCK" SEL-XREF))))
) ;_ end of open-ressource
(initget "Ja Nein")
(setq FRAGE
(getkword
"\nXREF wurde im Original extern geöffnet. Jetzt neu laden? [Ja/Nein]<Ja>: "
) ;_ end of getkword
) ;_ end of setq
(if (not FRAGE)
(setq FRAGE "Ja")
) ;_ end of if
(if (= FRAGE "Ja")
(progn
(command "_.-xref" "_reload" SEL-XREF)
(princ "\nOK, XREF wurde aktualisiert !")
) ;_ end of progn
(princ
"\nOK, XREF wurde auf Deinen Wunsch hin NICHT neu geladen !"
) ;_ end of princ
) ;_ end of if
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
(defun C:BOPEN (/ SEL-XREF XREF-LST F-SEL-XREF ALT-REGENMODE FRAGE)
(setq XREF-LST (VON-TABLE 14)) ;_ Liste erstellen, nur interne Blocks
(if (not XREF-LST)
(alert
"Keine Blöcke in aktueller Zeichnung definiert! Funktionsende."
) ;_ end of princ
(progn
(setq SEL-XREF (dos_listbox
"Interne Blöcke in aktueller Zeichnung"
"Wähle zu findenden Blocknamen..."
XREF-LST
) ;_ end of dos_listbox
) ;_ end of setq
(cond
((not SEL-XREF)
(alert "Kein Block zum Öffnen ausgewählt! Funktionsende.")
)
(t
(setq F-SEL-XREF (findfile (strcat SEL-XREF ".dwg"))) ;_ Wenn BLOECKE in Suchpfad
(if (not F-SEL-XREF)
(alert
(strcat
"Der Block: \""
(strcase SEL-XREF)
"\""
"\nbefindet sich nicht innerhalb der Acad-Suchpfade!\nFunktionsende."
) ;_ end of strcat
) ;_ end of alert
(progn
(OPEN-RESSOURCE
F-SEL-XREF
) ;_ end of open-ressource
(initget "Ja Nein")
(setq FRAGE
(getkword
"\nBlock wurde extern geöffnet. Jetzt neu laden? [Ja/Nein]<Ja>: "
) ;_ end of getkword
) ;_ end of setq
(if (not FRAGE)
(setq FRAGE "Ja")
) ;_ end of if
(if (= FRAGE "Ja")
(progn
(command "_.-insert"
(strcat SEL-XREF "=")
"0,0,0"
""
""
""
) ;_ fügt Block erneut und aktualisiert ein
(entdel (entlast)) ;_ Dummy-Block löschen
(princ "\nOK, Block wurde aktualisiert !")
) ;_ end of progn
(princ
"\nOK, Block wurde auf Deinen Wunsch hin NICHT aktualisiert !"
) ;_ end of princ
) ;_ end of if
) ;_ end of progn
) ;_ end of if
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
(defun OPEN-RESSOURCE (PFAD / LOADED OEFFNE_DATEI)
(cond
((> (getvar "sdi") 0) ;_ Single Doc Mode
(setq OEFFNE_DATEI
(strcat "acad.exe "
PFAD
) ;_ end of strcat
) ;_ end setq
(startapp OEFFNE_DATEI)
)
(t
(if (= (type AXOPEN) 'SUBR)
(setq LOADED t)
(setq LOADED (load "axopen.vlx" "err"))
) ;_ end of if
(if (eq LOADED "err")
(alert
"Sorry, konnte Datei \"AXOPEN.VLX\" nicht laden.\nÜberprüfen Sie die Systemeinstellungen!"
) ;_ end of alert
(progn (AXOPEN PFAD))
) ;_ end of if
) ;_ end of T
) ;_ end of cond
) ;_ end of defun
;;; Gibt eine Liste zurück, in der nur bestimmte Items enthalten sind
;;; Funktion ist Bitcodiert.
;;; nil, wenn nix enthalten ist.
;;; Bitcode 6 für XREF-Funktion
;;; Bitcode 14 für BLOCK-FUNKTION
;;; Auszug aus AI_TABLE:
;;; (ai_table <table name> <bit> )
;;;
;;; Returns a list of items in the specified table. The bit values have the
;;; following meaning:
;;; 0 List all items in the specified table.
;;; 1 Do not list Layer 0 and Linetype CONTINUOUS.
;;; 2 Do not list anonymous blocks or anonymous groups.
;;; A check against the 70 flag for the following bit:
;;; 1 anonymous block/group
;;; 4 Do not list externally dependant items.
;;; A check against the 70 flag is made for any of the following
;;; bits, which add up to 48:
;;; 16 externally dependant
;;; 32 resolved external or dependant
;;; 8 Do not list Xrefs.
;;; A check against the 70 flag for the following bit:
;;; 4 external reference
;;; 16 Add BYBLOCK and BYLAYER items to list.
;;;
(defun VON-TABLE (Bit / BLCK-LST RES-LST TABLDATA)
(setq RES-LST '()
BLCK-LST (AI_TABLE "BLOCK" bit)
) ;_ end of setq
(if (and BLCK-LST (= bit 6)) ;_ Handling nur für Xref
(progn
(foreach ELEM BLCK-LST
(setq TABLDATA (entget (tblobjname "BLOCK" ELEM)))
(if (not (zerop (logand 4 (cdr (assoc 70 TABLDATA)))))
(setq RES-LST (cons ELEM RES-LST))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
(setq RES-LST BLCK-LST)
) ;_ end of if
(setq BLCK-LST RES-LST)
) ;_ end of defun
(princ
"\noeffnen.lsp.... \(C\)1998 Scherer\nAufruf mit XOPEN für XREF's, BOPEN für Blöcke!"
) ;_ end princ
(princ)
Foren auf CAD.de (alle Foren)
| 
Gruß Sebastian , Ffm
