obviously haven't tested your app but I can say that around line 55 you have an if-statement with 3 parts.:
1 setq and 2 progn. If statement can only have two parts.
maybe your setq belongs inside one of the progn , above the if-command or inside the or-command?
(if (or (< (ascii char2) 58) (> (ascii char2) 47))
; [ 0 1 2 3 4 5 6 7 8 9 ]
(setq str2 (strcat str2 char2))
;value str2 --> A0M05 )
(PROGN
(COND
((= str2 "A0M04") (setq sstr2 "DIN125A-A0M04-E"))
....
)
(progn
....
)
)
oh and at the end I miss a closing ) after (princ) but that's maybe a paste error
totaal niet getest...
;;; on the character A after -.
(defun c:DIN125A ( / )
;;; zoek je hier op layer of op kadernaam? indien layer verander "BLOCK" in "LAYER"
(if (tblsearch "BLOCK" "BL$2----_KADER")
(DIN125AA) (alert "Kan Commando niet uitvoeren.\nGeen Kader aanwezig !!!"))
(princ)
)
(defun DIN125AA (/ A B str pos char1 char2 str2 sstr2 osm OLDLAYER LAY Y)
(cond
((not (setq A (entsel "\nSelecteer een Bout: ")))
(alert "Niets geselecteerd"))
((not (eq (cdr (assoc 0 (entget (car A)))) "INSERT"))
(alert "Selectie is geen Block\nStart opnieuw"))
((not (and (setq str (cdr (assoc 2 (entget (car A))))) (setq pos (+ 2 (vl-string-position 45 str)))
(eq (setq char1 (strcase (substr str pos 1))) "A")))
(alert "Selectie is geen Bout\nStart opnieuw"))
(t
;;; first after A
(setq char2 (substr str (+ 1 pos) 1))
;;; kleiner dan 53 maar groter dan 47 [0 t/m 4]
;;; A + 1ste getal 0 2 4
(if (or (< (ascii char2) 53) (> (ascii char2) 47)) (setq str2 (strcat char1 char2)))
;;; second after A
(setq char2 (substr str (+ 2 pos) 1))
;;; [ M ] 77
;;; value str2 --> A 0 1 2 M.
(if (or (< (ascii char2) 78) (> (ascii char2) 76)) (setq str2 (strcat str2 char2)))
;;; third after A
(setq char2 (substr str (+ 3 pos) 1))
;;; [ 0 1 ] 48 and 49
;;;value str2 --> A [0 1 2] M [0 1]
(if (or (< (ascii char2) 50) (> (ascii char2) 47))
(setq str2 (strcat str2 char2)))
;;; fourth after A
(setq char2 (substr str (+ 4 pos) 1))
;;; [ 0 1 2 3 4 5 6 7 8 9 ]
;;; value str2 --> A0M05
(setq str2 (strcat str2 char2))
(if (or (< (ascii char2) 58) (> (ascii char2) 47))
(progn
(cond
;;; VERZINKT 8.8
((= str2 "A0M04") (setq sstr2 "DIN125A-A0M04-E"))
((= str2 "A0M05") (setq sstr2 "DIN125A-A0M05-E"))
((= str2 "A0M06") (setq sstr2 "DIN125A-A0M06-E"))
((= str2 "A0M08") (setq sstr2 "DIN125A-A0M08-E"))
((= str2 "A0M10") (setq sstr2 "DIN125A-A0M10-E"))
((= str2 "A0M12") (setq sstr2 "DIN125A-A0M12-E"))
((= str2 "A0M14") (setq sstr2 "DIN125A-A0M14-E"))
((= str2 "A0M16") (setq sstr2 "DIN125A-A0M16-E"))
((= str2 "A2M04") (setq sstr2 "DIN125A-A2M04-E"))
;;;RVS A2
((= str2 "A2M05") (setq sstr2 "DIN125A-A2M05-E"))
((= str2 "A2M06") (setq sstr2 "DIN125A-A2M06-E"))
((= str2 "A2M08") (setq sstr2 "DIN125A-A2M08-E"))
((= str2 "A2M10") (setq sstr2 "DIN125A-A2M10-E"))
((= str2 "A2M12") (setq sstr2 "DIN125A-A2M12-E"))
((= str2 "A2M14") (setq sstr2 "DIN125A-A2M14-E"))
((= str2 "A2M16") (setq sstr2 "DIN125A-A2M16-E"))
((= str2 "A4M04") (setq sstr2 "DIN125A-A4M04-E"))
;;; RVS A4
((= str2 "A4M05") (setq sstr2 "DIN125A-A4M05-E"))
((= str2 "A4M06") (setq sstr2 "DIN125A-A4M06-E"))
((= str2 "A4M08") (setq sstr2 "DIN125A-A4M08-E"))
((= str2 "A4M10") (setq sstr2 "DIN125A-A4M10-E"))
((= str2 "A4M12") (setq sstr2 "DIN125A-A4M12-E"))
((= str2 "A4M14") (setq sstr2 "DIN125A-A4M14-E"))
((= str2 "A4M16") (setq sstr2 "DIN125A-A4M16-E"))
) ;;; end cond
(setq osm (getvar "osmode")) (setvar "osmode" 545)
(setq OLDLAYER (getvar "CLAYER"))
(if (not (tblsearch "LAYER" (setq lay "03_GEOMETRIE_050")))
(command "LAYER" "M" lay "C" "7" "" "L" "CONTINUOUS" "" ""))
(command "LAYER" "S" lay "")
(setq Y (getpoint "\nGeef Invoegpunt : "))
(command "-Insert" sstr2 Y "" "" Pause)
(setvar "CLAYER" OLDLAYER)
(setvar "osmode" osm)
);;; end progn
(alert "Computer says no...")
);;; end if
);;; end t cond
);;; end cond
(princ)
)
ps. don't you overcomplicate things a little in your code , maybe something like this could work too? :
(defun c:patjeacad ( / blk str bn ip)
(cond
((not (tblsearch "BLOCK" "BL$2----_KADER"))
(alert "Computer says no : No border in current drawing"))
((not (setq blk (entsel "\nSelect a bolt : ")))
(alert "Computer says no : nothing selected"))
((not (eq (cdr (assoc 0 (entget (car blk)))) "INSERT"))
(alert "Computer says no : selected item is not a block"))
((not (setq str (cdr (assoc 2 (entget (car blk))))))
(alert "Computer says no : bad block name"))
((wcmatch str "*A0M04*") (setq bn "DIN125A-A0M04-E"))
((wcmatch str "*A0M05*") (setq bn "DIN125A-A0M05-E"))
((wcmatch str "*A0M06*") (setq bn "DIN125A-A0M06-E"))
;;; ....
(t (setq bn nil) (alert "Computer says no : invalid block"))
)
;;; ...
(if (and bn (setq ip (getpoint "\nInsertion point : ")))
(command "-Insert" bn ip "" "" Pause))
;;; ...
(princ)
)