Error in lisp, table form block attributes

[zwonko]

Hello,

I'm trying to merge few other lisp capabilities into one, and I'm doing something wrong.

I had the block with atrributes and get it from the Lee Mac lisp. Also had a lisp witch making table (form polylines lenght). Trying to mod it tto lisp that will enter atrributes to table. 

First make simple lisp witch is getting atrrib using LeeMac funcion.

(defun c:getplate ( / e x )
    (if (and (setq e (car (entsel "\nSelect plate description block: ")))
             (= "INSERT" (cdr (assoc 0 (entget e))))
        )
        (setq B (LM:vl-getattributevalue (vlax-ename->vla-object e) "B"))
    )
        (setq H (LM:vl-getattributevalue (vlax-ename->vla-object e) "H"))
        (setq L (LM:vl-getattributevalue (vlax-ename->vla-object e) "L"))

        (princ (strcat "\n" "widht=" B ", height=" H ", lenght=" L))
    (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))
)

 

 

Second trying to put it inside other lisp witch is making table:

 

(defun c:steeltab (/ s x y doc objtable numrows rowheight pt1 colwidth curspace)
;; Tharwat 26. 08. 2015 ;
;; mods by BIGAL 29.08.2015 now as table
;;mods by ZW

(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  "))) 
(princ "\nSelect Blocks :")
(setq s (ssget '((0 . "INSERT") (2 . "steel_numb_ZW") ))) ; 
(if (/= s nil)
   (progn
 ; now do table 
   (setq numrows (+ 2 (sslength s)))
   (setq numcolumns 4)   ;number of columns
   (setq rowheight 60)   ; row height
   (setq colwidth 270)	;
   (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
   (vla-settext objtable 0 0 "Plates")
   (vla-setcolumnwidth objtable 0 90)    ;width first column
   (vla-setcolumnwidth objtable 1 180)	;width second column
   (vla-setcolumnwidth objtable 2 180)	;width third column
   (vla-setcolumnwidth objtable 3 180)	;width fourth column
   (vla-settext objtable 1 0 "Nu.") 
   (vla-settext objtable 1 1 "Widht")
   (vla-settext objtable 1 2 "Height") 
   (vla-settext objtable 1 3 "Lenght") 
   (vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 40)	;text height
   (vla-SetAlignment Objtable acDataRow acMiddleCenter)

   (setq x 1)
   (SETQ Y 2)
   (setq r -1)
   ;((lambda (r / e)
        (while (setq e (ssname s (setq r (1+ r))))
    (setq blk (ssname s (setq i (1- i))))
(c:platetabsingle)


        (vla-settext objtable Y 0 B)  ; 
        (vla-settext objtable Y 1 B)   ; 
        (vla-settext objtable Y 2 B)  ;   
        (vla-settext objtable Y 3 B)   ; 
        (setq x (1+ x ))
        (setq y (1+ Y ))
 ); while
    ; )) ;lambda
     )   ;progn
   (alert "You have not picked any block")
   )     ; if      
 (princ)

) ; defun





(defun c:platetabsingle ( / e x )
    (if (and (setq e (car e))
             (= "INSERT" (cdr (assoc 0 (entget e))))
        )
        (setq B (LM:vl-getattributevalue (vlax-ename->vla-object e) "B"))
    )
        (setq H (LM:vl-getattributevalue (vlax-ename->vla-object e) "H"))
        (setq L (LM:vl-getattributevalue (vlax-ename->vla-object e) "L"))

        (princ (strcat "\n" "widht=" B ", height=" H ", lenght=" L))
    (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))
)

 

Propably error is somewhere in the "e", but I'm too nooby in lisp to catch it. I was trying to change "e" using car, cadr, vlax-ename->vla-object and other stuff which difference in this lisp but spending few hours give me nothing...
 

steel_leader_v2.0.dwg

[rlx]

maybe this will work

Zwonko.lsp

[zwonko]

Thanks so much. It works!

 I corrected my other mistakes and that is a last version..

 

(defun c:getplate ( / e x )
  (if (and (setq e (car (entsel "\nSelect plate description block: "))) (= "INSERT" (cdr (assoc 0 (entget e)))))
    (setq B (LM:vl-getattributevalue (vlax-ename->vla-object e) "B")))
  (setq H (LM:vl-getattributevalue (vlax-ename->vla-object e) "H"))
  (setq L (LM:vl-getattributevalue (vlax-ename->vla-object e) "L"))
  (princ (strcat "\n" "widht=" B ", height=" H ", lenght=" L))
  (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))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:steeltab  (/ s x y doc objtable numrows rowheight pt1 colwidth curspace)
  ;; Tharwat 26. 08. 2015 ;
  ;; mods by BIGAL 29.08.2015 now as table
  ;;mods by ZW
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq curspace (vla-get-modelspace doc))
  (setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  ")))
  (princ "\nSelect Blocks :")
  (setq s (ssget '((0 . "INSERT") (2 . "steel_numb_ZW")))) ; 
  (if (/= s nil)
    (progn ; now do table 
      (setq numrows (+ 2 (sslength s)))
      (setq numcolumns 4) ;number of columns
      (setq rowheight 60) ; row height
      (setq colwidth 270) ;
      (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
      (vla-settext objtable 0 0 "Plates")
      (vla-setcolumnwidth objtable 0 90) ;width first column
      (vla-setcolumnwidth objtable 1 180) ;width second column
      (vla-setcolumnwidth objtable 2 180) ;width third column
      (vla-setcolumnwidth objtable 3 180) ;width fourth column
      (vla-settext objtable 1 0 "Nu.")
      (vla-settext objtable 1 1 "Widht")
      (vla-settext objtable 1 2 "Height")
      (vla-settext objtable 1 3 "Lenght")
      (vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 40) ;text height
      (vla-SetAlignment Objtable acDataRow acMiddleCenter)
      (setq x 1)
      (SETQ Y 2)
      (setq r -1) ;((lambda (r / e)
      (while (setq e (ssname s (setq r (1+ r))))
        ;;; *** (setq blk (ssname s (setq i (1- i)))) ***
        ;;; *** var i was not defined  / while loop uses r -> (setq r (1+ r)) ***
        (setq blk (ssname s r))
        ;;; *** changed c:platetabsingle -> (platetabsingle blk) so entity retrieved with ssname is passed as argument to function ***
        (platetabsingle blk)
        (vla-settext objtable Y 0 Nu) ; 
        (vla-settext objtable Y 1 B) ; 
        (vla-settext objtable Y 2 H) ;   
        (vla-settext objtable Y 3 L) ; 
        (setq x (1+ x))
        (setq y (1+ Y))
      ) ; while
    ) ;progn
    (alert "You have not picked any block")
  ) ; if      
  (princ)
) ; defun




;;; *** changed c:platetabsingle -> platetabsingle with e as argument
(defun platetabsingle ( e / x )
  ;;; *** made check for e , if e is ename and if e is insert ****
  (if (and e (= (type e) 'ENAME)  (= "INSERT" (cdr (assoc 0 (entget e)))))
    (setq B (LM:vl-getattributevalue (vlax-ename->vla-object e) "B")))
  (setq H (LM:vl-getattributevalue (vlax-ename->vla-object e) "H"))
  (setq L (LM:vl-getattributevalue (vlax-ename->vla-object e) "L"))
  (setq Nu (LM:vl-getattributevalue (vlax-ename->vla-object e) "PLATENUMBER"))
  (princ (strcat "\n" "widht=" B ", height=" H ", lenght=" L))
  (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))
)

 

 

I'm leaving it here. Maybe someone other will use it. 

I will use it to get a table of steel plates or steel profiles to the table.

[devitg]

 

 

erased

 

Edited July 11, 2021 by devitg
post by error