---

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

---

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

---

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

---

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

---

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

---

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

---

Danke Cadmium,
hilft mir wirklich weiter.
Gruß
Niggemann

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