Hot News aus dem CAD.de-Newsletter:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  vlax-get-or-create-object unter ACAD2010 funktioniert nicht mehr

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
Autor Thema:   vlax-get-or-create-object unter ACAD2010 funktioniert nicht mehr (139 mal gelesen)
Niggemann
Mitglied



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

Beiträge: 136
Registriert: 31.10.2003

Win 98 Se, ACAD 2004, XP Prof, ACAD 2004 und ACAD 2010

erstellt am: 19. Feb. 2017 01:25    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

Hallo zusammen,
unter ACAD 2010 funktioniert folgende Funktion nicht mehr:
(defun CHECK_DATUM (KEY DATUM / MATH RET)
  (setq MATH (vlax-get-or-create-object "ScriptControl"))
  (vlax-put MATH "Language" "VBScript")
  (if (= -1 (vlax-invoke MATH "EVAL" (strcat "IsDate(\"" DATUM "\")")))
    (progn
    (setq RET (vlax-invoke MATH "EVAL" (strcat "cstr(CDate(\"" DATUM "\"))")))
    (set_tile KEY RET)
    )
    (progn
    (setq RET nil)
    (alert "Die Eingabe des Datums ist nicht Korrekt gültige Eingaben sind z.B.
27.6.2011, 27.Juni.2011, Juni.27.2011, heraus kommt dann immer 27.06.2011.
Für die Monate können auch die gebräuchlichen Kürzel wie
Jan, Feb, Mär, Jun, Jul, Aug, Sep, Okt, Nov oder Dez eingegeben werden."
    )
    (vlr-beep-reaction)
    (mode_tile KEY 2)
    )
  )
  (vlax-release-object MATH)
;  RET
  )
Diese Funktion verwende des öffteren um ein Datum zu prüfen.
Weis jemand wo der Fehler liegt?
Unter ACAD2004 gibt es keine Propleme
Gruß
Niggemann

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

CADmium
Moderator
Maschinenbaukonstrukteur




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

Beiträge: 13185
Registriert: 30.11.2003

.

erstellt am: 19. Feb. 2017 13:39    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 Niggemann 10 Unities + Antwort hilfreich

geraten ... (vlax-get-or-create-object "ScriptControl") klappt nur auf 32bit Systemen ... programier dir die Funktion sauber in Lisp nach und gut ist ....

------------------
Also ich finde Unities gut ... und andere sicher auch
---------------------------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

Niggemann
Mitglied



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

Beiträge: 136
Registriert: 31.10.2003

Win 98 Se, ACAD 2004, XP Prof, ACAD 2004 und ACAD 2010

erstellt am: 19. Feb. 2017 16:06    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

Hallo Cadmium,
habe ich vor Jahren schon mal probiert und hat nicht funktioniert,
mir fehlt einfach der richtige Ansatz. Wenn du mir einen Tipp geben kannst währe ich die Dankbar.
Gruß
Niggemann

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: 17067
Registriert: 14.06.2002

System: F1
und Google

erstellt am: 19. Feb. 2017 18:25    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 Niggemann 10 Unities + Antwort hilfreich

Da dürfte es keinen Trick geben (was das komplette nachproggn angeht, ohne fremdcodes zu integrieren)

Ansätze gibt es wohl mehrere, doch Anfangen würde ich in jedem Fall mit einer Split-String Funktion.
Zerlege den String anhand der zulässigen Trennzeichen Punkt,Komma, Space

Prüfen ab eine Liste mit drei Einträgen entstanden ist.
Dann fängt die Prüferei an.

Jahr nur aus Zahlen, nur zwei oder vierstellig, zulässig.
Gewünschtes Jahresformat ausgeben.
Die Sinnhaftigkeit der Jahreszahl sollte vorher noch geprüft werden.

Monat, hier könnte man ganz "dumm" mit member und einer Vorgabeliste mit allen möglichen Werten schauen ob ein gültiger Wert vorliegt, da kann man sich dann Typumwandlungen sparen.
(cond
((member MM '("JUN" "JUNE" "JUNI" "6" "06"))
"06")
)

Tag, in Integer umwandeln un prüfen ob der Wert sinnig ist, in Abhängigkeit von Monat und (Schalt-)Jahr nur 28-31,
Rückgabe in gewünschter Form als String.

Itoa rtos strcase cond member if strcat
eine String Split Funktion findet man auch fertig im Forum/www

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

Niggemann
Mitglied



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

Beiträge: 136
Registriert: 31.10.2003

Win 98 Se, ACAD 2004, XP Prof, ACAD 2004 und ACAD 2010

erstellt am: 19. Feb. 2017 19:41    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

Danke für deinen Tipp, hab mir sowas schon gedacht. 2011 war ich froh das ich was im Forum gefunden habe womit ich mir die Arbeit ersparen konnte.
Gruß
Niggemann

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

CADmium
Moderator
Maschinenbaukonstrukteur




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

Beiträge: 13185
Registriert: 30.11.2003

.

erstellt am: 19. Feb. 2017 22:11    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 Niggemann 10 Unities + Antwort hilfreich

na ich hab dir mal was zusammenkopiert und angepasst und vielleicht etwas Arbeit abgenommen ..

(defun DATE_CHECK(DATE / DT:STR-DIVS-SET DATUM->DATELIST DT ATE-OK? DT:LEADING-ZERO DATELIST)
  (defun DT:STR-DIVS-SET(STRING SEPARATORLIST / SEPARATOR LISTE RETURN)
    (if(=(type STRING) 'STR)
      (if(and(=(type SEPARATORLIST) 'LIST)
            (setq SEPARATORLIST (vl-remove-if-not
                                  '(lambda(x)(and(=(type X)'Str)(vl-string-search x STRING)))
                                  SEPARATORLIST
                                )
            )         
        )
      (progn
        (while(setq LISTE
                (vl-remove-if-not
                  '(lambda(y)(numberp(car y)))                                       
                    (mapcar'(lambda(x)(list(vl-string-search x STRING)X (1+(strlen x))))SEPARATORLIST)
                )
              )     
          (setq SEPARATOR(assoc(apply 'min (mapcar 'car LISTE))LISTE))
          (setq RETURN(cons(substr STRING 1 (car SEPARATOR))RETURN))
          (setq STRING(substr STRING (+ (car SEPARATOR) (caddr SEPARATOR))))
        )
        (setq RETURN(reverse(cons STRING RETURN)))
      ) 
      STRING
      )
      STRING
    )
  )
  (defun DATUM->DATELIST (DATUM / DATELIST TAG MONATJAHR )
    (if(and(=(type DATUM)'STR)
          (setq DATELIST(DT:STR-DIVS-SET DATUM '("." " ")))
          (setq DATELIST(vl-remove-if '(lambda(X)(= X ""))DATELIST))
          (=(length DATELIST)3)
          (setq  TAG  (atoi(car  DATELIST)))(/=  TAG 0)
          (setq JAHR  (atoi(caddr DATELIST)))(/= Jahr 0)
          (setq MONAT (cadr DATELIST))
          (setq MONAT(cond
                        ((member (strcase MONAT)'("JAN"    "JANUAR"))  1)
                        ((member (strcase MONAT)'("FEB"  "FEBRUAR"))  2)
                        ((member (strcase MONAT)'("MAR"      "MÄRZ"))  3)
                        ((member (strcase MONAT)'("APR"    "APRIL"))  4)
                        ((member (strcase MONAT)'("MAI"      "MAI"))  5)
                        ((member (strcase MONAT)'("JUN"      "JUNI"))  6)
                        ((member (strcase MONAT)'("JUL"      "JULI"))  7)
                        ((member (strcase MONAT)'("AUG"    "AUGUST"))  8)
                        ((member (strcase MONAT)'("SEP" "SEPTEMBER"))  9)
                        ((member (strcase MONAT)'("OKT"  "OKTOBER")) 10)
                        ((member (strcase MONAT)'("NOV"  "NOVEMBER")) 11)
                        ((member (strcase MONAT)'("DEZ"  "DEZEMBER")) 12)
                        ((and(setq MONAT(atoi MONAT))(/= MONAT 0))MONAT)
                      )
          )     
      )
      (list JAHR MONAT TAG)
    )
  ) 
  (defun DT ATE-OK?(DATELIST  / JAHR MONAT TAG)
    (if (and (=(type DATELIST) 'LIST) (= (length DATELIST) 3)
            (= (type (setq      JAHR    (nth 0 DATELIST))) 'INT)
            (= (type (setq MONAT  (nth 1 DATELIST))) 'INT)
            (= (type (setq TAG    (nth 2 DATELIST))) 'INT)
            (>= JAHR -4713)
            (>= MONAT    1) (<= MONAT        12)         
            (cond
              ((member MONAT '(1 3 5 7 8 10 12))(and(>= TAG  1) (<= TAG 31)))
              ((member MONAT '(4 6 9 11))(and(>= TAG  1) (<= TAG 30)))
              ((= MONAT 2)               
                (if (zerop (-(/ JAHR 4.0)(fix(/ JAHR 4.0))))
                  (if (zerop (-(/ JAHR 100.0)(fix(/ JAHR 100.0))))
                    (if (and(zerop (-(/ JAHR 400.0)(fix(/ JAHR 400.0)))) (/= KALENDER "J"))
                      (and(>= TAG  1) (<= TAG 29))
                      (and(>= TAG  1) (<= TAG 28))
                    )                 
                    (and(>= TAG  1) (<= TAG 29))
                  )
                  (and(>= TAG  1) (<= TAG 28))
                )
              )
            )
        ) 
      DATELIST
    ) 
  )
  (defun DT:LEADING-ZERO(STRING COUNT)
    (if (and (= (type STRING) 'STR)(= (type COUNT) 'INT))
      (cond
        ( (=(strlen STRING) COUNT ) STRING )
        ( (>(strlen STRING) COUNT ) (substr STRING 1 COUNT))
        ( 'T (repeat (- COUNT (strlen STRING)) (setq STRING(strcat "0" STRING))))
      )
    )
  )
 
  (if(and(setq DATELIST(DATUM->DATELIST DATE))
        (setq DATELIST(DT ATE-OK? DATELIST))
    )
    (strcat (DT:LEADING-ZERO (itoa (nth 2 DATELIST)) 2) "."
            (DT:LEADING-ZERO (itoa (nth 1 DATELIST)) 2) "."
            (DT:LEADING-ZERO (itoa (nth 0 DATELIST)) 4)
            (if (< (nth 0 DATELIST) 0)  " v.u.Z" "")
    )
  )
)


Aufrufbsp :
(DATE_CHECK "12.02.2017")
(DATE_CHECK "12.September 2017")
(DATE_CHECK "12. JUL 2017")

------------------
Also ich finde Unities gut ... und andere sicher auch
---------------------------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

Niggemann
Mitglied



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

Beiträge: 136
Registriert: 31.10.2003

Win 98 Se, ACAD 2004, XP Prof, ACAD 2004 und ACAD 2010

erstellt am: 20. Feb. 2017 00:17    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

Danke Cadmium,
hilft mir wirklich weiter.
Gruß
Niggemann

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)2017 CAD.de