@Sea-Haven @paullimapa
So this is my revision of the code after breaking it down and trying to understand what every thing is doing. I was able to debug the errors. I can now produce a list the way I need it. Next step Is to use this list to autofill a block with assigned tables. I have a lisp that will grab mtext and place the values in. Which I will add as well. I would like to find a way to use this stored information already to bypass placing a block; this has me purge it and convert text to mtext, and then I use the lisp to fill the block.
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-for-combining-multiple-block-attributes-into-a-main-block/td-p/11637019
; an attempt by AlanH Dec 2022
;itteration by TCB Jan 2023
(defun c:fiber ()
(princ "\n Pick 1 block object for block name ")
(setq ss (ssget "_+.:E:S" '((0 . "INSERT"))))
(if (= ss nil)
(alert "You may not have picked a block please try again")
(progn
(setq blk (vlax-ename->vla-object (ssname ss 0)))
(setq bname (vla-get-name blk))
(if (wcmatch bname "*U#*")
(setq bname (vla-get-effectivename blk))
);end if
(princ "\nSelect the blocks ")
(setq ss (ssget '((0 . "INSERT"))))
(if (= ss nil)
(alert "No blocks picked will exit")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq blk (vlax-ename->vla-object ent))
(setq blkname (vla-get-name blk))
(if (wcmatch blkname "*U#*")
(setq blkname (vla-get-effectivename blk))
);end if
(if (= blkname bname)
(progn
(setq atts (vlax-invoke blk 'Getattributes))
(if (= atts nil)
(princ "No Atts")
(progn
(foreach att atts
(setq lst2 (cons (vla-get-textstring att) lst2))
)
(setq odname (ade_odgettables ent))
(setq Fbss (ade_odgetfield ent odname "FIBER_ASSIGNEMENT" 0))
(setq Stnum (ade_odgetfield ent odname "STREET_NUMBER" 0))
(setq Stname (ade_odgetfield ent odname "STREET_NAME" 0))
(setq state (ade_odgetfield ent odname "STATE" 0))
(setq Pcode (ade_odgetfield ent odname "POSTAL_CODE" 0))
(setq lst (cons (list (strcat Fbss " | " stnum " " stname " " state " " pcode)) lst))
); end prog
);end if
);end prog
);end if
);end repeat
);end prog
);end if
);end progn
);end if
);end fun
Mtext to block
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mtext-to-block-data/td-p/11593844
;ronjonp Dec 2022
(defun c:MTTB ( / LM:str->lst lstProps eMtext lstMtext eBlock)
;;MText - To - Block
(defun LM:str->lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(setq lstProps '("ASSIGNMENT_I" "ASSIGNMENT_II" "ASSIGNMENT_III" "ASSIGNMENT_IV" "ASSIGNMENT_V" "ASSIGNMENT_VI"
"ASSIGNMENT_VII" "ASSIGNMENT_VIII" "ASSIGNMENT_IX" "ASSIGNMENT_X" "ASSIGNMENT_XI" "ASSIGNMENT_XII"))
(if (and (setq eMtext (car (entsel "\nSelect MText: ")))
(eq "MTEXT" (cdr (assoc 0 (entget eMtext))))
(setq lstMtext (LM:str->lst (getpropertyvalue eMtext "Text") "\r")
lstMtext (vl-remove "" (apply 'append (mapcar '(lambda (x) (LM:str->lst x "\n")) lstMtext))))
);and
(if (and (setq eBlock (car (entsel "\nSelect Block for MText Values: ")))
(eq "INSERT" (cdr (assoc 0 (entget eBlock))))
(eq "FIBER_PED" (strcase (getpropertyvalue eBlock "BlockTableRecord/Name")))
);and
(mapcar
'(lambda (prop str) (setpropertyvalue eBlock prop str))
lstProps
lstMtext
);mapcar
;else
(prompt "\nBad BLOCK entity...")
);if
;else
(prompt "\nBad MTEXT entity...")
);if
(prompt "\nMTTB Complete.")
(princ)
);defun
