Using LISp to edit my Block with an Excel Sheet

[jhowell787JM]

Why is AutoCAD not detecting my block name, "1A-Plan_A". Here is the routine I am running, and the properties dialog box of the block in discussion please help me resolve this issue. 

;; -----------------------------------------

;; UPDATE ATTRIBUTES FOR BLOCK: 1A-PLAN_A

;; ATTRIBUTES: NA, NB, ND1, ND2, NE1, NE2, NHAD, NSHAD

;; -----------------------------------------

(defun StrSplit (str delim / pos lst)

  (while (setq pos (vl-string-search delim str))

    (setq lst (cons (substr str 1 pos) lst))

    (setq str (substr str (+ pos (strlen delim) 1)))

  )

  (reverse (cons str lst))

)

(defun ReadCSV (path / file line rows)

  (setq file (open path "r"))

  (while (setq line (read-line file))

    (setq rows (cons (StrSplit line ",") rows))

  )

  (close file)

  (reverse rows)

)

(defun GetAttributes (blk)

  (vl-remove-if

    'null

    (mapcar

      '(lambda (x)

         (if (= (vla-get-ObjectName x) "AcDbAttribute")

           x

         )

       )

      (vlax-safearray->list

        (vlax-variant-value (vla-getAttributes blk))

      )

    )

  )

)

(defun c:UpdatePlanA ( / csv data headers rows ss blk att tag idx row rowIndex)

  (setq csv (getfiled "Select CSV file" "" "csv" 0))

  (if (not csv)

    (progn (princ "\nCanceled.") (exit))

  )

  ;; Read CSV

  (setq data (ReadCSV csv))

  (setq headers (mapcar 'strcase (car data)))

  (setq rows (cdr data))

  ;; Select block by exact name

  (setq ss (ssget "X" '((2 . "1A-PLAN_A"))))

  (if (not ss)

    (progn (princ "\nNo blocks named 1A-PLAN_A found.") (exit))

  )

  (setq rowIndex 0)

  ;; Update each block

  (repeat (sslength ss)

    (setq blk (vlax-ename->vla-object (ssname ss rowIndex)))

    (setq row (nth rowIndex rows))

    (setq attlist (GetAttributes blk))

    (foreach att attlist

      (setq tag (strcase (vla-get-TagString att)))

      (setq idx (vl-position tag headers))

      (if idx

        (vla-put-TextString att (nth idx row))

      )

    )

    (setq rowIndex (1+ rowIndex))

  )

  (princ "\n✓ Block 1A-PLAN_A updated.")

  (princ)

)

 

[paullimapa]

What if you try

(setq ss (ssget "_x" '((0 . "INSERT")(2 . "1A-PLAN_A")))

could you share sample dwg and csv?

[Sea-Haven]

Just me and some criticize, I read the Excel sheet directly. No need to make a csv. So yes post dwg and CSV/Excel.

[jhowell787JM]

I apologize for the late response I am not the admin on my account so bare with me. but here is the info you asked for and I tried your code adjustment but it didn't work.

 

[jhowell787JM]

I just posted above, thank you for your help!

[paullimapa]

I made the following changes:

1) Localize the 3 functions StrSplit ReadCSV GetAttributes by moving them inside the c:UpdatePlanA function:

(defun c:UpdatePlanA 
 ( / GetAttributes ReadCSV StrSplit csv data headers rows ss blk att tag idx row rowIndex)
   
(vl-load-com)
; localize functions   
(defun StrSplit (str delim / pos lst)
  (while (setq pos (vl-string-search delim str))
    (setq lst (cons (substr str 1 pos) lst))
    (setq str (substr str (+ pos (strlen delim) 1)))
  )
  (reverse (cons str lst))
)

(defun ReadCSV (path / file line rows)
  (setq file (open path "r"))
  (while (setq line (read-line file))
    (setq rows (cons (StrSplit line ",") rows))
  )
  (close file)
  (reverse rows)
)

(defun GetAttributes (blk)
  (vl-remove-if
    'null
    (mapcar
      '(lambda (x)
         (if (= (vla-get-ObjectName x) "AcDbAttribute")
           x
         )
       )
      (vlax-safearray->list
        (vlax-variant-value (vla-getAttributes blk))
      )
    )
  )
)

2) Since 1A-PLAN_A is a dynamic Block & not a standard Block & with attributes the ssget function needs to look like this:

  ;; Select block by exact name
  (setq ss (ssget "_X" '((2 . "`*U*,1A-PLAN_A")(66 . 1)))) ; select all blocks including dynamic blocks with attributes
  ; (setq ss (ssget "X" '((2 . "1A-PLAN_A"))))

3) Since this selects all dynamic blocks, you'll have to evaluate the effective Block name matches 1A-PLAN_A inside the repeat function:

  ;; Update each block
  (repeat (sslength ss)
   (setq blk (vlax-ename->vla-object (ssname ss rowIndex)))
   (if (eq (vla-get-effectivename blk) "1A-PLAN_A") ; chk if dynamic block matches block name
    (progn 

4) Since your CSV file contains all text strings AutoCAD reads them and surrounds them with additional quotes changing the values to look like this:

So I modified the CSV read value by using this line of code which only works as long as the values are in inches:

      (if idx
        (vla-put-TextString att (strcat (read (nth idx row)) "\""))
;        (vla-put-TextString att (nth idx row))
      ) ; if

[tnunneryBQFBL]

When I save each of these localized routines, are they going to be in different save files?

[paullimapa]

If they are localized that means they are included inside the main defun statement. If you plan to use these as global then they need to be saved in another lisp file that you would need to load first before running this lisp file. Also this line:

(defun c:UpdatePlanA 
 ( / GetAttributes ReadCSV StrSplit csv data headers rows ss blk att tag idx row rowIndex)

would drop those three functions 

(defun c:UpdatePlanA 
 ( / csv data headers rows ss blk att tag idx row rowIndex)

[tnunneryBQFBL]

Thank you so much for your help! This is the best lisp I've used and it still has the two trailing quotation marks(""). 

(defun c:UpdatePlanA
(/ StrSplit ReadCSV GetAttributes StripQuotes CleanUnicode CleanField csv rows headers ss blk att attlist tag val row rowIndex)

(vl-load-com)

;; ----------------------------
;; Split a CSV line
;; ----------------------------
(defun StrSplit (str delim / pos lst)
(while (setq pos (vl-string-search delim str))
(setq lst (cons (substr str 1 pos) lst))
(setq str (substr str (+ pos (strlen delim) 1)))
)
(reverse (cons str lst))
)

;; ----------------------------
;; Remove only wrapping quotes (keep inches)
;; ----------------------------
(defun StripQuotes (s)
;; remove only leading and trailing quote if both exist
(if (and (> (strlen s) 1)
(= (substr s 1 1) "\"")
(= (substr s (strlen s) 1) "\""))
(substr s 2 (- (strlen s) 2))
s
)
)

;; ----------------------------
;; Remove Unicode smart quotes and BOM
;; ----------------------------
(defun CleanUnicode (s)
(foreach pair
'(("“" . "\"") ("”" . "\"")
("‘" . "'") ("’" . "'")
("\uFEFF" . "") ;; BOM
)
(setq s (vl-string-subst (cdr pair) (car pair) s))
)
s
)

;; ----------------------------
;; Full field cleaner: trim, strip wrapping quotes only, remove tabs/CR, clean Unicode
;; ----------------------------
(defun CleanField (s)
(setq s (vl-string-trim " \t\r\n" s)) ;; trim whitespace & control chars
(setq s (StripQuotes s)) ;; remove only wrapping quotes
(setq s (CleanUnicode s)) ;; normalize unicode
(while (vl-string-search " " s) ;; remove double spaces
(setq s (vl-string-subst " " " " s))
)
s
)

;; ----------------------------
;; Read CSV file into list (cleaned)
;; ----------------------------
(defun ReadCSV (path / file line rows fields)
(setq file (open path "r"))
(while (setq line (read-line file))
(setq fields (StrSplit line ","))
(setq fields (mapcar 'CleanField fields))
(setq rows (cons fields rows))
)
(close file)
(reverse rows)
)

;; ----------------------------
;; Get ATTRIBUTE objects safely
;; ----------------------------
(defun GetAttributes (blk)
(vl-remove-if
'null
(mapcar
'(lambda (x)
(if (= (vla-get-ObjectName x) "AcDbAttribute")
x
)
)
(vlax-safearray->list
(vlax-variant-value (vla-getAttributes blk))
)
)
)
)

;; ----------------------------
;; READ CSV FILE (network path, escaped)
;; ----------------------------
(setq csv (ReadCSV "P:\\TYLER FOLDER\\UpdatePlanA.csv"))
(setq headers (car csv))
(setq rows (cdr csv))

;; ----------------------------
;; SELECT BLOCK REFERENCES
;; ----------------------------
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1)))) ;; get all block refs w/ attributes

(setq rowIndex 0)

;; ----------------------------
;; LOOP THROUGH SELECTION SET
;; ----------------------------
(repeat (sslength ss)

(setq blk (vlax-ename->vla-object (ssname ss rowIndex)))
(setq rowIndex (1+ rowIndex))

;; Only process dynamic blocks whose effective name = "1A-PLAN_A"
(if (= (vla-get-EffectiveName blk) "1A-PLAN_A")

(progn
(setq attlist (GetAttributes blk))
(setq row (nth (- rowIndex 1) rows)) ;; match row to block position

;; ----------------------------
;; Update attributes
;; ----------------------------
(foreach att attlist
(setq tag (strcase (vla-get-TagString att)))

;; find matching header
(setq idx (vl-position tag (mapcar 'strcase headers)))

(if idx
(progn
(setq val (nth idx row))
(vla-put-TextString att val) ;; val now keeps inch marks
)
)
)
)
)
)

(princ "\nDone updating PLAN_A blocks.")
(princ)
)

Can you tell me where it's incorrect?

[paullimapa]

can you also share your CSV file if you changed the contents from before?

[tnunneryBQFBL]

i haven't changed the csv. file at all

[paullimapa]

I'm unable to get this function you added to run through...instead the code just gets stuck here and I would have to hit Esc to get out

(defun CleanField (s)
(setq s (vl-string-trim " \t\r\n" s)) ;; trim whitespace & control chars
(setq s (StripQuotes s)) ;; remove only wrapping quotes
(setq s (CleanUnicode s)) ;; normalize unicode
(while (vl-string-search " " s) ;; remove double spaces
(setq s (vl-string-subst " " " " s))
)
s
)

Also you dropped the selection of dynamic blocks  by changing this ssget function to this:

(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1)))) ;; get all block refs w/ attributes

It should stay as :

(setq ss (ssget "_X" '((2 . "`*U*,1A-PLAN_A")(66 . 1)))) ; select all blocks including dynamic blocks with attributes

[paullimapa]

Ok, I figured out what the problem was with the pasted code in your message.

This CleanField function is missing the second space when you copy & pasted the code directly into the body of the message:

(while (vl-string-search " " s) ;; remove double spaces
(setq s (vl-string-subst " " " " s))
)

The better way to copy & paste code is to first click on this </> on the top bar of the message composition window:

Then paste the code into the popup window that appears:

    (while (vl-string-search "  " s)  ;; remove double spaces
      (setq s (vl-string-subst " " "  " s))
    )

Now the double spaces appear properly.

Also for very long code it's best to include as attachment by dragging & dropping into the section at the bottom of the message composition window:

Or you can also just click on the word browse and then select "Show all files" to look for the file on the saved location to attach.

1) To remove that last hanging quote I added one more line of code at the end of the CleanField function:

  ;; ----------------------------
  ;; Full field cleaner: trim, strip wrapping quotes only, remove tabs/CR, clean Unicode
  ;; ----------------------------
  (defun CleanField (s) 
    (setq s (vl-string-trim " \t\r\n" s)) ;; trim whitespace & control chars
    (setq s (StripQuotes s)) ;; remove only wrapping quotes
    (setq s (CleanUnicode s)) ;; normalize unicode
    (while (vl-string-search "  " s)  ;; remove double spaces
      (setq s (vl-string-subst " " "  " s))
    )
    (setq s (vl-string-subst "" "\"" s)) ; removes quote at end 
    s
  )

2)  I also began & ended the UpdatePlanA function with Undo Begin & Undo End so that after running UpdatePlanA you can enter Undo to revert back to before running the function.

  ;; ---------------------------
  ;; Begin Undo
  ;; ---------------------------  
  (command "_.Undo" "_Be") 

  ;; ---------------------------
  ;; End Undo
  ;; ---------------------------  
  (command "_.Undo" "_E") 

3) After reading the CSV file I changed the code so that the header row is retrieved and capitalized and the single row of data after is also retrieved:

;  (setq headers (car csv)) ; header labels
  (setq headers (mapcar 'strcase (car csv))) ; capitalize header labels
;  (setq rows (cdr csv))  
  (setq rows (cadr csv))  ; get one row of data

4)  I added back the checking of selection set in case nothing is found the code exits:

  ;; ----------------------------
  ;; SELECT BLOCK REFERENCES
  ;; ----------------------------
  ;(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1)))) ;; get all block refs w/ attributes
  (setq ss (ssget "_X" '((2 . "`*U*,1A-PLAN_A") (66 . 1)))) ; select all blocks including dynamic blocks with attributes

  (if (not ss)
    (progn (princ "\nNo blocks named 1A-PLAN_A found.") (exit))
  )

5) Since the headers have already been capitalized & data row has already been retrieved, the follow changes are also made here:

    ;; Only process dynamic blocks whose effective name = "1A-PLAN_A"
    (if (= (vla-get-EffectiveName blk) "1A-PLAN_A") 

      (progn 

        (setq attlist (GetAttributes blk))
;        (setq row (nth (- rowIndex 1) rows)) ;; match row to block position

        ;; ----------------------------
        ;; Update attributes
        ;; ----------------------------
        (foreach att attlist 
          (setq tag (strcase (vla-get-TagString att)))

          ;; find matching header
;          (setq idx (vl-position tag (mapcar 'strcase headers)))
          (setq idx (vl-position tag headers))

          (if idx 
            (progn 
;              (setq val (nth idx row))
              (setq val (nth idx rows))
              (vla-put-TextString att val) ;; val now keeps inch marks
            )
          )
        )
      )
    )

6) Lastly I used Visual Studio Code's right mouse click and Format Document feature to properly format (beatify) the code:

Check out the attached modified code.

[tnunneryBQFBL]

NICCCEEE THANKS FOR YOUR HELP!!!

[paullimapa]

you are welcome...cheers!!!