Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/01/2022 in all areas

  1. That's left over from when i had and output that of the count as well. but your right only needs this. (foreach itm lst (write-line (strcat (car itm)) file) )
    2 points
  2. There is no benefit of checking if the (cdr itm) is bigger than one because the following two statements are the same.
    2 points
  3. This is perfect and just what I was needing. I did make a slight change because I am looking for a list of unique value that we can pull into another scripting language to perform additional actions. So, I removed the count information within the write line so it will only list the detail values only. ; Removed the following (foreach itm lst (if (> (cdr itm) 1) (write-line (strcat (car itm) " Found " (rtos (cdr itm)2 0) " Times") file) (write-line (strcat (car itm) " Found " (rtos (cdr itm)2 0) " Time") file) ) ) ; Replace with (foreach itm lst (if (> (cdr itm) 1) (write-line (strcat (car itm)) file) (write-line (strcat (car itm)) file) ) ) So the final version of the code if needed by future users is: ;; Write list of unique details to csv file in dwg folder (defun DBEXT (/ TagList ss root file i TagRow ValRow Edata lst) (vl-load-com) (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble")))) (progn (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq blk (vlax-ename->vla-object ent)) (setq x (strcat (LM:vl-getattributevalue blk "DETAIL_NUMBER") "-" (LM:vl-getattributevalue blk "SHEET_NUMBER"))) (if (assoc x lst) (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst)) (setq lst (cons (cons x 1) lst)) ) ) (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))) file (open (strcat (getvar 'DWGPREFIX) "_Details.csv") "w") ) (foreach itm lst (if (> (cdr itm) 1) (write-line (strcat (car itm)) file) (write-line (strcat (car itm)) file) ) ) (close file) (startapp "C:/Program Files (x86)/Microsoft Office/root/Office16/EXCEL.EXE" (strcat (getvar 'DWGPREFIX) "_Details.csv")) ) ) (princ) (princ "\nSaved Details CSV File!\n") (princ) );defun ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) );defun Thank you so much for your time and help on this everyone. Cheers!
    1 point
  4. I ended up just addding a pair of commands at the start to set ANG BASE and ANGDIR to default values, and then resetting it back to our values at the end. Seems to work, but would be nice to figure out the "correct" solution rather than just a work-around.
    1 point
  5. Hello, (defun c:fix() (setq mysel (ssget '((0 . "TEXT")))) (setq od (getvar "dimzin")) (setvar "dimzin" 1) (setq number 0) (setq dec (getint "\nnº decimals= ")) (while (setq entity1 (ssname mysel number)) (setq t1 (entget entity1)) (setq text (cdr (assoc 1 t1))) (setq text (vl-string-subst "." "," text)) (setq num (atof text)) (setq num (rtos num 2 dec)) (setq num (vl-string-subst "," "." num)) (setq par (cons 1 num)) (setq t1 (subst par (assoc 1 t1) t1)) (entmod t1) (setq number (1+ number)) ) (setvar "dimzin" od) )
    1 point
  6. 1 point
  7. Download Notepad++ it has a lsp style option it is well worthwhile for checking open & close brackets, it also has a run lisp from Notepad code, so you can test as you write. See red brackets check
    1 point
  8. Did a complete re write. outputs to a txt file instead of csv don't have excel at home. Will display as BRK-0104 Found 2 Times BRK-0108 Found 2 Times BRK-0148 Found 2 Times BRK-0201 Found 2 Times BRK-0212 Found 2 Times .... RFM-0220 Found 6 Times ;;----------------------------------------------------------------------;; ;; LIST BLOCK ATTRIBUTE CALLOUTS AND HOW MANY TIMES FOUND (defun C:DBEXT (/ TagList ss root file i TagRow ValRow Edata lst) (vl-load-com) (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble")))) (progn (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq blk (vlax-ename->vla-object ent)) (setq x (strcat (LM:vl-getattributevalue blk "DETAIL_NUMBER") "-" (LM:vl-getattributevalue blk "SHEET_NUMBER"))) (if (assoc x lst) (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst)) (setq lst (cons (cons x 1) lst)) ) ) (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))) file (open (strcat (getvar 'DWGPREFIX) "Details.txt") "w") ) (foreach itm lst (if (> (cdr itm) 1) (write-line (strcat (car itm) " Found " (rtos (cdr itm)2 0) " Times") file) (write-line (strcat (car itm) " Found " (rtos (cdr itm)2 0) " Time") file) ) ) (close file) (startapp "notepad" (strcat (getvar 'DWGPREFIX) "Details.txt")) ) ) (princ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) )
    1 point
  9. Like Steven P pick a task just remember crawl, then walk, then run. Dont pick something to complicated. Most of us are still at a fast walk, with burst of speed. Once you have a task, ask not for code but method and you will get a lot of support if you have a go .
    1 point
  10. Did you search YouTube? beginner autocad lisp routines - YouTube AfraLISP is a good start point as well....Learn AutoLISP for AutoCAD productivity | AfraLISP Here is a start....
    1 point
  11. Best way is to just go for it, rather than watching a video and learn by doing. So think of something that would be useful to automate with a script, post a question on here saying you want to learn and I am sure people will help you along the way
    1 point
×
×
  • Create New...