Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  DesignCenter Datei-Erweiterungs-Enabler

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  DesignCenter Datei-Erweiterungs-Enabler (1259 mal gelesen)
marc.scherer
Ehrenmitglied V.I.P. h.c.
CAD-Administrator



Sehen Sie sich das Profil von marc.scherer an!   Senden Sie eine Private Message an marc.scherer  Schreiben Sie einen Gästebucheintrag für marc.scherer

Beiträge: 2490
Registriert: 02.11.2001

Windows 10 64bit
AutoCAD Architecture 2018/2019 (deu/eng)
AEC-Collection 2019 (Revit und Zeugs)
Wenn sich's nicht vermeiden läßt:
D-A-CH Erweiterung (mies implementierter Schrott)

erstellt am: 01. Mrz. 2004 17:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hi,
wie schon im RuA- Forum angekündigt, hier das vorläufige Tool
zum aktivieren/deaktivieren von Dateierweiterungen die eigentlich DWG's sind, standardmäßig aber vom DesignCenter nicht angezeigt werden.
Wünsche, Fragen, Anregungen bitte hier posten.
Code:

(vl-load-com)

(defun C:ADC+ (/ ERASEFLAG EXTENSION)
(if (not (REG:TESTWRITE))
(alert
(strcat
"Sorry, Sie haben keine Schreib-Rechte auf die Windows-Registrierung."
"\nKontaktieren Sie Ihren CAD-Admin oder loggen Sie sich als User"
"\nmit entsprechenden Rechten auf der lokalen Maschine ein."
) ;_ end of strcat
) ;_ end of alert
(progn
(initget 1 "dwT dwS Alle-genannten")
(setq EXTENSION
(getkword
"DateiTyp-Unterstützung für DesignCenter manipulieren, Erweiterung wählen [dwT/dwS/Alle-genannten]: "
) ;_ end of getkword
) ;_ end of setq
(if EXTENSION
(progn
(initget "Aktivieren Deaktivieren")
(setq ERASEFLAG
(getkword
(strcat
"\nDesignCenter-Unterstützung für "
(strcase EXTENSION)
" Dateityp(en) [Aktivieren/Deaktivieren]<Aktivieren>? "
) ;_ end of strcat
) ;_ end of getkword
) ;_ end of setq
(if (or (not ERASEFLAG) (= ERASEFLAG "Aktivieren"))
(setq ERASEFLAG NIL)
(setq ERASEFLAG t)
) ;_ end of if
(if (= EXTENSION "Alle-genannten")
(mapcar
(function (lambda (X) (MS:DC-SWITCH-EXTENSION ERASEFLAG X))
) ;_ end of function
'("dwt" "dws")
) ;_ end of mapcar
(MS:DC-SWITCH-EXTENSION ERASEFLAG EXTENSION)
) ;_ end of if
(if ERASEFLAG
(princ (strcat "\nOK, DesignCenter-Unterstützung für "
(strcase EXTENSION)
" Dateityp(en) DEAKTIVIERT."
) ;_ end of strcat
) ;_ end of princ
(princ (strcat "\nOK, DesignCenter-Unterstützung für "
(strcase EXTENSION)
" Dateityp(en) AKTIVIERT."
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
(princ "\nÄnderungen werden erst nach einem Neustart von AutoCAD übernommen.")
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun


;;; erzeugt oder löscht den DCenter-Wert für die übergebene Extension.
;;; Argumente:
;;; ERASEFLAG = nil oder T, wenn T wird die extension gelöscht, wenn nil erzeugt
;;; EXTENSION = Zeichenkette, definiert die zu berücksichtigende Dateierweiterung
;;; Prüfung auf Länge und "dw" Anfang
;;;
;;; Funktion legt in jedem Fall eine Backup-Extension der "dwg" als "..." an.
(defun MS:DC-SWITCH-EXTENSION (ERASEFLAG EXTENSION
/ ADCBACKUPKEY
ADCDWGKEY ADCEXTKEY
ADCKEY ADCTARGETKEY
CHANGED-EXT WRITE-BACKUP
)
(setq EXTENSION (strcase EXTENSION t))
(if (and (= (strlen EXTENSION) 3) (wcmatch EXTENSION "dw?"))
(progn
(if (setq ADCKEY (REG:ACADDCKEY))
(progn
(setq ADCEXTKEY (strcat ADCKEY "\\" "Extensions")
ADCTARGETKEY (strcat ADCEXTKEY "\\." EXTENSION)
ADCBACKUPKEY (strcat ADCEXTKEY "\\.zzz")
ADCDWGKEY (strcat ADCEXTKEY "\\.dwg")
) ;_ end of setq
;; Cleanup Backup-Pfad
(if (member ".zzz" (vl-registry-descendents ADCEXTKEY)) ;_ existiert der Backup-Eintrag schon?
(if
(not (REG:TEST-LAYOUT-CLSID ADCBACKUPKEY)) ;_ existiert, aber keine Daten gesichert...
(setq WRITE-BACKUP t) ;_ erzeuge Backup
(setq WRITE-BACKUP NIL) ;_ Backup existiert schon
) ;_ end of if
(setq WRITE-BACKUP t) ;_ erzeuge Backup
) ;_ end of if
(if WRITE-BACKUP
(progn
(setq CHANGED-EXT
(REG:->KEY-LST-STRING-SUBST
"zzz"
"dwg"
(REG:->KEY-VALUE-LST ADCDWGKEY)
) ;_ end of REG:->KEY-LST-STRING-SUBST
) ;_ end of setq
(REG:WRITE-KEY-VALUE-LST CHANGED-EXT)
) ;_ end of progn
) ;_ end of if
(if ERASEFLAG
(if (REG:TEST-LAYOUT-CLSID ADCTARGETKEY)
(REG:DELETE-KEY-VALUE-LST
(REG:->KEY-VALUE-LST ADCTARGETKEY)
) ;_ end of REG:DELETE-KEY-VALUE-LST
) ;_ end of if
(REG:WRITE-KEY-VALUE-LST
(REG:->KEY-LST-STRING-SUBST
EXTENSION
"zzz"
(REG:->KEY-VALUE-LST ADCBACKUPKEY)
) ;_ end of REG:->KEY-LST-STRING-SUBST
) ;_ end of REG:WRITE-KEY-VALUE-LST
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of defun

;;; Gibt den Namen "HKEY_LOCAL_MACHINE" zurück
(defun REG:WINBASEKEY (/)
"HKEY_LOCAL_MACHINE"
) ;_ end of defun

;;; Gibt den Namen "HKEY_LOCAL_MACHINE\\SOFTWARE" zurück
(defun REG:WINSOFTWAREKEY (/)
(strcat (REG:WINBASEKEY) "\\" "SOFTWARE")
) ;_ end of defun

;;; Liest den DesignCenter Key für die aktuell laufende AutoCAD-VErsion aus
(defun REG:ACADDCKEY (/ DCKEY retval)
(setq DCKEY "AutodeskApps\\AcadDC" ;_ Teilschlüssel zum ADC Eintrag von R2000 bis R2004 identisch
RETVAL (strcat (REG:WINBASEKEY) "\\" (vlax-product-key) "\\" DCKEY)
) ;_ end of setq
(if (not (vl-registry-descendents RETVAL))
(setq RETVAL NIL)
) ;_ end of if
retval
) ;_ end of defun

;;; Liest einen Registry-Tree ab dem übergebenen Key
;;; und erzeugt daraus eine entsprechende, hierarchische Liste:
;;; Format:
;;; ("KEYNAME" [((VALUENAME . VALUEDATA)(VALUENAME . VALUEDATA)...) oder nil] [SUBKEY-LIST oder nil])
;;; Format der SUBKEY-LIST: Liste von Listen, die genauso wie die Hauptliste aufgebaut sind.
;;; Verschachtelung entsprechend des Registry-Trees.
;;; Z.B.:
;;; ("HKEY_LOCAL_MACHINE\\Software\\Autodesk\\...\\.dwg"
;;; (("Container" . 1)
;;; ("Default_IconIndex" . 2)
;;; ("Default_Clsid" . "{C8F4366D-BAC6-4463-9F42-C2627D8E86FB}")
;;; )
;;; (("HKEY_LOCAL_MACHINE\\Software\\Autodesk\\...\\.dwg\\Blocks" (("LocalName" . "Blöcke")...) nil)
;;; ("HKEY_LOCAL_MACHINE\\Software\\Autodesk\\...\\.dwg\\Dimstyles" (("LocalName" . "Bemstile")... ) nil)
;;; ("HKEY_LOCAL_MACHINE\\Software\\Autodesk\\...\\.dwg\\Layers" (("LocalName" . "Layer")...) nil)
;;; (...)
;;; )
;;; )
(defun REG:->KEY-VALUE-LST (KEY / RETVAL SUBKEYNAMES VNAMES)
;; Value-Handling für Key
(if (setq VNAMES (reverse (vl-registry-descendents KEY t))) ;_ hat der Key values?
(setq
VNAMES (mapcar (function (lambda (X)
(cons X (vl-registry-read KEY X))
) ;_ end of lambda
) ;_ end of function
VNAMES
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of if
(setq RETVAL (list KEY VNAMES))
(if (setq SUBKEYNAMES (reverse (vl-registry-descendents KEY)))
(setq SUBKEYNAMES
(mapcar
(function (lambda (X)
(REG:->KEY-VALUE-LST (strcat KEY "\\" X))
) ;_ end of lambda
) ;_ end of function
SUBKEYNAMES
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of if
(append RETVAL (list SUBKEYNAMES))
) ;_ end of defun

;;; tauscht einen String in allen Keys der Registry-Tree-Liste
(defun REG:->KEY-LST-STRING-SUBST
(NEW PATTERN KEYLST / ELEM-NEU KEY SUB-KEY-LST SUB-KEY-LST-NEW)
(setq KEY (car KEYLST)
KEYLST (subst (vl-string-subst NEW PATTERN KEY) KEY KEYLST)
) ;_ end of setq
(if (setq SUB-KEY-LST (nth 2 KEYLST))
(foreach ELEM SUB-KEY-LST
(setq SUB-KEY-LST-NEW
(cons
(REG:->KEY-LST-STRING-SUBST NEW PATTERN ELEM)
SUB-KEY-LST-NEW
) ;_ end of cons
) ;_ end of setq
) ;_ end of foreach
) ;_ end of if
(setq KEYLST (list (nth 0 KEYLST)
(nth 1 KEYLST)
(reverse SUB-KEY-LST-NEW)
) ;_ end of list
) ;_ end of setq
) ;_ end of defun

;;; Erzeugt alle Registrierungseinträge die in der übergebenen Registry-Tree-Liste
;;; enthalten sind.
(defun REG:WRITE-KEY-VALUE-LST (LST / KEY SUB-LST VAL-LST)
(if (setq KEY (car LST))
(if (vl-registry-write KEY)
(progn
(if (setq VAL-LST (nth 1 LST))
(foreach ELEM VAL-LST
(vl-registry-write KEY (car ELEM) (cdr ELEM))
) ;_ end of foreach
) ;_ end of if
(if (setq SUB-LST (nth 2 LST))
(foreach ELEM SUB-LST
(REG:WRITE-KEY-VALUE-LST ELEM)
) ;_ end of foreach
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of if
) ;_ end of defun

;;; Löscht alle Registrierungseinträge die in der übergebenen Registry-Tree-Liste
;;; enthalten sind.
(defun REG:DELETE-KEY-VALUE-LST (LST / SUB-KEYS)
(while (not (vl-registry-delete (car LST)))
(if (setq SUB-KEYS (nth 2 LST))
(foreach ELEM SUB-KEYS
(REG:DELETE-KEY-VALUE-LST ELEM)
) ;_ end of foreach
) ;_ end of if
) ;_ end of while
) ;_ end of defun

;;; Testfunktion: Kann der User in die Registrierung schreiben?
(defun REG:TESTWRITE (/ RETVAL TESTKEY)
(setq TESTKEY (strcat (REG:WINSOFTWAREKEY) "\\" "VLWRITETEST")
RETVAL (vl-registry-write TESTKEY)
) ;_ end of setq
(if RETVAL
(vl-registry-delete TESTKEY)
) ;_ end of if
RETVAL
) ;_ end of defun

;;; Testet für einen übergebenen Key, ob es für den SubKey "Layouts",
;;; Wertname "CLSID" einen Wert gibt.
(defun REG:TEST-LAYOUT-CLSID (key /)
(vl-registry-read (strcat key "\\Layouts") "CLSID")
) ;_ end of defun


;;; Liest die Keys für den übergebenen Schlüssel in "HKEY_LOCAL_MACHINE\\SOFTWARE"
;;; aus. z.B.: (REG:FIND-SW-KEYS "Autodesk")
(defun REG:FIND-SW-KEYS (SWKEY / RETVAL)
(setq RETVAL (REG:WINSOFTWAREKEY)
SWKEY (strcase SWKEY)
) ;_ end of setq
(if (member SWKEY (mapcar 'strcase (vl-registry-descendents RETVAL)))
(setq RETVAL (vl-registry-descendents (strcat RETVAL "\\" SWKEY)))
(setq RETVAL NIL)
) ;_ end of if
(reverse RETVAL)
) ;_ end of defun



..

------------------
Ciao,
Marc

[Diese Nachricht wurde von marc.scherer am 01. Mrz. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Proxy
Ehrenmitglied
Stateless-DHCP v6-Paketfragmentierer


Sehen Sie sich das Profil von Proxy an!   Senden Sie eine Private Message an Proxy  Schreiben Sie einen Gästebucheintrag für Proxy

Beiträge: 1629
Registriert: 13.11.2003

Tastaturen, Mäuse,
Pladden, ...,
AutoCADs 200X, SWX 2kX

erstellt am: 02. Mrz. 2004 07:50    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für marc.scherer 10 Unities + Antwort hilfreich

1a-Tool (bis ein paar kleine Tipfehler).

------------------
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?"  Read the whole story: The Autodesk File ca. 890 Seiten | 7500 KB PDF

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

cadffm
Moderator
良い精神




Sehen Sie sich das Profil von cadffm an!   Senden Sie eine Private Message an cadffm  Schreiben Sie einen Gästebucheintrag für cadffm

Beiträge: 21533
Registriert: 03.06.2002

Alles

erstellt am: 02. Mrz. 2004 07:58    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für marc.scherer 10 Unities + Antwort hilfreich

Klasse Marc, !

EDITEDITEDIT-

[Diese Nachricht wurde von cadffm am 02. Mrz. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

marc.scherer
Ehrenmitglied V.I.P. h.c.
CAD-Administrator



Sehen Sie sich das Profil von marc.scherer an!   Senden Sie eine Private Message an marc.scherer  Schreiben Sie einen Gästebucheintrag für marc.scherer

Beiträge: 2490
Registriert: 02.11.2001

Windows 10 64bit
AutoCAD Architecture 2018/2019 (deu/eng)
AEC-Collection 2019 (Revit und Zeugs)
Wenn sich's nicht vermeiden läßt:
D-A-CH Erweiterung (mies implementierter Schrott)

erstellt am: 02. Mrz. 2004 09:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

@Proxy, sag' mal Tipp-Fehler, wenn Du sie schon gefunden hast (brauche ich dann nicht mehr gucken :-)

------------------
Ciao,
Marc

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Proxy
Ehrenmitglied
Stateless-DHCP v6-Paketfragmentierer


Sehen Sie sich das Profil von Proxy an!   Senden Sie eine Private Message an Proxy  Schreiben Sie einen Gästebucheintrag für Proxy

Beiträge: 1629
Registriert: 13.11.2003

Tastaturen, Mäuse,
Pladden, ...,
AutoCADs 200X, SWX 2kX

erstellt am: 03. Mrz. 2004 07:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für marc.scherer 10 Unities + Antwort hilfreich

Ich meiente einfach paar Leerzeichen hier und da der Optik wegen und die Rechtschreibung bei manchen Wörtern ist "grausam" geDenglished 

------------------
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?"  Read the whole story: The Autodesk File ca. 890 Seiten | 7500 KB PDF

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Alpschorsch
Mitglied
Dipl.-Ing.(FH) Architektur


Sehen Sie sich das Profil von Alpschorsch an!   Senden Sie eine Private Message an Alpschorsch  Schreiben Sie einen Gästebucheintrag für Alpschorsch

Beiträge: 735
Registriert: 18.11.2003

ACAD 2004,Express Tools, WIN 2000,

erstellt am: 03. Mrz. 2004 09:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für marc.scherer 10 Unities + Antwort hilfreich

@ marc.scherer,

super Idee und ein super Tool!
Volle Punktzahl in Pflicht und Kür!

Gruß Alpschorsch

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz