Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/19/2024 in all areas

  1. If it is in quotes, " " it is seen as a string, you'll want to create the string with something like: (command "line" p1 (strcat "@" (rtos bm) "<90") "")
    2 points
  2. @EnM4st3r Just checked both the codes. The first one is the one i wanted. cheers mate. much appreciated. Tomorrow i will run on my actual file that contains around 2500 plines. Thank a lot once again.
    1 point
  3. Try this to avoid selecting two points twice... (setq p1 (getpoint) p2 (getpoint p1) p3 (getpoint p2) p4 (getpoint p3) p5 (getpoint p4) p6 (getpoint p5) p7 (getpoint p6) p8 (getpoint p7) )
    1 point
  4. 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) )
    1 point
  5. You can use this code (not written by me) then set it up in your cui to have 'nextlayout' and 'previouslayout' as keyboard shortcut commands.... ;; Created by: Lee Ambrosius ;; Date Written: 12/11/03 ;; Includes four commands which can be redefined. ;; NextLayout - Navigates to the right and will wrap around ;; to the left side once the end is reached ;; PreviousLayout - Navigates to the left and will wrap around ;; to the right side once the end is reached ;; FirstLayout - Navigates to the left most tab ;; LstLayout - Navigates to the right most tab ;; Gets a listing of all Layouts in the drawing (defun Get-Layout-List( / acadObj acDoc acDocLayouts layoutCount loopCount layoutListLocal layoutListSorted layoutName layoutPosition loopCountSorted) (vl-load-com) (setq acadObj (vlax-get-acad-object)) (setq acDoc (vlax-get-property acadObj 'ActiveDocument)) (setq acDocLayouts (vlax-get-property acDoc 'Layouts)) (setq layoutCount (vlax-get-property acDocLayouts 'Count) loopCount 0 layoutListLocal (list) layoutListSorted (list) ) (while (> layoutCount loopCount) (setq layoutName (vlax-get-property (vlax-invoke-method acDocLayouts 'Item loopCount) 'Name)) (setq layoutPosition (vlax-get-property (vlax-invoke-method acDocLayouts 'Item loopCount) 'TabOrder)) (setq layoutListLocal (append layoutListLocal (list (list layoutPosition layoutName)))) (setq loopCount (1+ loopCount)) ) ;; Resort listing by TabOrder (setq layoutCountSorted 0) (while (> (length layoutListLocal) (length layoutListSorted)) (setq loopCountSorted 0) (foreach layoutLocation layoutListLocal (progn (if (and (= (car layoutLocation) (length layoutListSorted)) (= (car layoutLocation) layoutCountSorted)) (progn (setq layoutListSorted (append layoutListSorted (cdr (nth loopCountSorted layoutListLocal)))) (setq layoutCountSorted (1+ layoutCountSorted)) ) ) (setq loopCountSorted (1+ loopCountSorted)) ) ) ) layoutListSorted ) (defun c:nextlayout ( / layout-mem-list layout-list layoutLocation) (setq layoutLocation 0) (setq layout-list (get-layout-list)) (setq layout-mem-list (member (getvar "CTAB") layout-list)) (if layout-mem-list (progn (setq layoutLocation (- (length layout-list) (length layout-mem-list))) ) (setq layoutLocation (1+ layoutLocation)) ) (if (>= (1+ layoutLocation) (length layout-list)) (setvar "CTAB" (nth 0 layout-list)) (setvar "CTAB" (nth (1+ layoutLocation) layout-list)) ) ) (defun c:previouslayout ( / layout-mem-list layout-list layoutLocation) (setq layoutLocation 0) (setq layout-list (get-layout-list)) (setq layout-mem-list (member (getvar "CTAB") layout-list)) (if layout-mem-list (progn (setq layoutLocation (- (length layout-list) (length layout-mem-list))) ) (setq layoutLocation (1- layoutLocation)) ) (if (= layoutLocation 0) (setvar "CTAB" (nth (1- (length layout-list)) layout-list)) (setvar "CTAB" (nth (1- layoutLocation) layout-list)) ) ) (defun c:FirstLayout ( / layout-list layoutLocation) (setvar "CTAB" (nth 0 (get-layout-list))) ) (defun c:LastLayout ( / layout-list) (setq layout-list (get-layout-list)) (setvar "CTAB" (nth (- (length layout-list) 1) layout-list)) ) (princ)
    1 point
×
×
  • Create New...