patjeacad Posted June 15 Share Posted June 15 Dear programmers, I have a problem on a filter of a blockname. When it is the correct blockname there is no problem, when the blockname is incorrect it doesn't work wel. If i can check on more characters, and it does not match the characters needed, the funcktion has to end. The selection of the block is not the right one. At this moment there is only a check on the character A after -. (DEFUN c:DIN125A (/ FORMAAT) (SETQ FORMAAT (SSGET "X" (list (cons 8 "BL$2----_KADER")))) (IF (NOT FORMAAT)(ALERT "\n Kan Commando niet uitvoeren. Geen Kader aanwezig !!! ")) (IF FORMAAT (PROGN (DIN125AA))) (PRINC) ) (defun DIN125AA(/ A B str pos char1 char2 str2 sstr2 osm OLDLAYER LAY Y) (PROGN (SETQ A (ENTSEL "\nSelecteer een Bout: ")) (IF A (PROGN ;automatische selectie moer (SETQ B (CDR (ASSOC 0 (ENTGET (CAR A))))) (IF (NOT (= B "INSERT")) (ALERT "\nGeselecteerde is geen Block. Start opnieuw") ) (IF (= B "INSERT") (PROGN (setq str (CDR (ASSOC 2 (ENTGET (CAR A)))));DIN931-A0M06x45E (for example) (setq pos (+ 2 (vl-string-position 45 str))); - (setq char1 (strcase (substr str pos 1))) (IF (NOT (= char1 "A")) ; A (ALERT "\nGeselecteerde is geen Bout. Start opnieuw") ) (IF (= char1 "A") (progn (setq char2 (substr str (+ 1 pos) 1)) ; first after A (if (or (< (ascii char2) 53)(> (ascii char2) 47)) ; kleiner dan 53 maar groter dan 47 [0 t/m 4] (setq str2 (strcat char1 char2)) ; A + 1ste getal 0 2 4. ) (setq char2 (substr str (+ 2 pos) 1)) ; second after A (if (or (< (ascii char2) 78)(> (ascii char2) 76)) ; [ M ] 77. (setq str2 (strcat str2 char2)) ;value str2 --> A 0 1 2 M. ) (setq char2 (substr str (+ 3 pos) 1)) ; third after A (if (or (< (ascii char2) 50)(> (ascii char2) 47)) ; [ 0 1 ] 48 and 49 (setq str2 (strcat str2 char2)) ;value str2 --> A [0 1 2] M [0 1] ) (setq char2 (substr str (+ 4 pos) 1)) ; fourth after A (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"));VERZINKT 8.8 ((= 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")) ) ) (progn (setq osm (getvar "osmode")) (Setvar "osmode" 545) (SETQ OLDLAYER (GETVAR "CLAYER")) (SETQ LAY (IF (NOT (TBLSEARCH "LAYER" "03_GEOMETRIE_050")) (COMMAND "LAYER" "M" "03_GEOMETRIE_050" "C" "7" "" "L" "CONTINUOUS" "" "")) ) (COMMAND "LAYER" "S" "03_GEOMETRIE_050" "") (SETQ Y (getpoint "\nGeef Invoegpunt : ")) (Command "-Insert" sstr2 Y "" "" Pause) (SETVAR "CLAYER" OLDLAYER) (setvar "osmode" osm) ) ) ) ) ) (PRINC) ) ) ) ) (PRINC) Quote Link to comment Share on other sites More sharing options...
rlx Posted June 15 Share Posted June 15 (edited) 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) ) Edited June 16 by rlx 1 Quote Link to comment Share on other sites More sharing options...
patjeacad Posted June 19 Author Share Posted June 19 On 6/15/2024 at 5:33 PM, rlx said: 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) ) the first you made is working wel. The second i have to test. So far great support from you, thank you RLX On 6/15/2024 at 5:33 PM, rlx said: 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 I see, i think a copy error. Quote Link to comment Share on other sites More sharing options...
patjeacad Posted June 19 Author Share Posted June 19 On 6/15/2024 at 5:33 PM, rlx said: 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) ) Thanks RLX this works great. This is a better filter with more options for me. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 19 Share Posted June 19 Youre welcome patjeacad If your (old) blocknames have all the same format (letter A + number + letter M + 2 numbers) , things can be even shorter : (vl-load-com) ;;; ($p "DIN931-A0M06x45E" "*A#M##*") -> "A0M06" ;;; p = mask to search for do if you search for letter A + number + letter M + two numbers mask will be "*A#M##*" ;;; (# means any number , @ means any letter) (defun $p (s p)(if (and (wcmatch s p)(/= "" s))(cond (($p (substr s 2) p))(($p (substr s 1 (1- (strlen s))) p))(s)))) ;;; if for example your block name = "DIN931-A0M06x45E" (variable str in your app) (setq str "DIN931-A0M06x45E") (if (setq s ($p str "*A#M##*")) (setq sstr2 (strcat "DIN125A-" s "-E"))) (alert (vl-princ-to-string sstr2)) Quote Link to comment Share on other sites More sharing options...
patjeacad Posted June 19 Author Share Posted June 19 30 minutes ago, rlx said: Youre welcome patjeacad If your (old) blocknames have all the same format (letter A + number + letter M + 2 numbers) , things can be even shorter : (vl-load-com) ;;; ($p "DIN931-A0M06x45E" "*A#M##*") -> "A0M06" ;;; p = mask to search for do if you search for letter A + number + letter M + two numbers mask will be "*A#M##*" ;;; (# means any number , @ means any letter) (defun $p (s p)(if (and (wcmatch s p)(/= "" s))(cond (($p (substr s 2) p))(($p (substr s 1 (1- (strlen s))) p))(s)))) ;;; if for example your block name = "DIN931-A0M06x45E" (variable str in your app) (setq str "DIN931-A0M06x45E") (if (setq s ($p str "*A#M##*")) (setq sstr2 (strcat "DIN125A-" s "-E"))) (alert (vl-princ-to-string sstr2)) This is above my head. I try to understand it. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 19 Share Posted June 19 no problem , this site is all about learning. Just meant to say if all your old blocks have a blockname like ...A0M06... you may be able to compress your entire routine to : (defun c:patjeacad ( / $p blk str s bn ip) ;;; ($p "DIN931-A0M06x45E" "*A#M##*") -> "A0M06" (defun $p (s p)(if (and (wcmatch s p)(/= "" s)) (cond (($p (substr s 2) p))(($p (substr s 1 (1- (strlen s))) p))(s)))) (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")) ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-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) ) this line : ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-E"))) would replace your entire cond function with all the wcmatch's inside it. But cond function with all the wcmatches inside is OK too , keeps it nice and simple and easy to add future blocknames to it. In the end its not about what works for me but what best works for you. 1 Quote Link to comment Share on other sites More sharing options...
patjeacad Posted June 29 Author Share Posted June 29 On 6/19/2024 at 1:34 PM, rlx said: no problem , this site is all about learning. Just meant to say if all your old blocks have a blockname like ...A0M06... you may be able to compress your entire routine to : (defun c:patjeacad ( / $p blk str s bn ip) ;;; ($p "DIN931-A0M06x45E" "*A#M##*") -> "A0M06" (defun $p (s p)(if (and (wcmatch s p)(/= "" s)) (cond (($p (substr s 2) p))(($p (substr s 1 (1- (strlen s))) p))(s)))) (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")) ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-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) ) this line : ((setq s ($p str "*A#M##*")) (setq bn (strcat "DIN125A-" s "-E"))) would replace your entire cond function with all the wcmatch's inside it. But cond function with all the wcmatches inside is OK too , keeps it nice and simple and easy to add future blocknames to it. In the end its not about what works for me but what best works for you. This is a very short manner. it works perfect. nice explanation to make this function so short.. Dank je wel RLX. Fijn dat je mij hebt geholpen 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.