Get length of dimension on a block lisp

ancrayzy · ‎12-19-2021

Hi everyone,

I have a dynamic block with dimension to show the length of object.

Is there any lisp to get the text or lenght of dimesion and write to a table.

Regards

devitg · ‎12-20-2021

@ancrayzy DATAEXTRAXTION , acad command solve it .

when ask to use an existing dxe , choose the dxe attached at the zip file .

The zip files come from the ETRANSMIT from ACAD.

Also you will see the dwg with table and result .

calderg1000 · ‎12-20-2021

Saludos @ancrayzy

Con estas líneas de código "Test" puedes obtener el valor de la longitud asignada a la variable "d", para insertarlo en una tabla puedes tomar como base el código de la siguiente respuesta:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/width-depth-length-in-a-table/td-p/1...

(vla-settext objtable y 1 (rtos d 2 2))

Si tienes dificultad para hacerlo, luego con un poco de tiempo intentaré publicarlo.

(defun c: prueba (/ obj Ov Os d)
(setq obj (vlax-ename-> vla-object (car (entsel "\ nSeleccionar bloque:"))))
(si (= (vlax-get-property obj 'isdynamicblock): vlax-true)
(progn
(setq Ov (valor-variante vlax (vla-getdynamicblockproperties obj)))
(setq Os (vlax-safearray-> lista Ov))
(setq d (vlax-variant-value (vla-get-value (n-ésimo 0 Os))))
)
  )
  (princ (strcat "\ nL =" (rtos d 2 2)))
  (princ)
  )

* I made a slight correction

Carlos Calderon G

>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

ancrayzy · ‎12-20-2021

Thanks @devitg,
I working routines with this command but it gets lot of time than using auto lisp.

ancrayzy · ‎12-20-2021

Thanks @calderg1000

I combine your code as below but it don't work

(vla-settext objtable y 1 (rtos d 2 2))
(defun c:Getlenght ( / obj Ov Os d )
(setq obj(vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
(if (= (vlax-get-property obj 'isdynamicblock) :vlax-true)
(progn
(setq 
(setq Ov(vlax-variant-value (vla-getdynamicblockproperties obj)))
(setq Os(vlax-safearray->list Ov))
(setq d(vlax-variant-value(vla-get-value (nth 0 Os))))
)
  )
  (princ (strcat "\nL= " (rtos d 2 2)))
  (princ)
  )

calderg1000 · ‎12-21-2021

Regards @ancrayzy

Here is the following code, which gets the length of the dynamic block and inserts its value in a table. The current table style is set to "Standard"

; simple single column table
; By Alan H Aug 2019
; Edited to get the length property of a dynamic block
; calderg1000 Dic. 2021
vl-load-com)
(defun c:Dbl ( / pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable) 
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
(setvar 'ctablestyle "Standard") 
(command "_.dimstyle" "_restore" "Standard")
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  ")))
(setq numrows 2)
(setq numcolumns 1)
(setq rowheight 50)
(setq colwidth 300)
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "LENGTH TABLE")
(vla-settext objtable 1 0 "Length")
(vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 20)
(setq objtable (vlax-ename->vla-object (entlast)))
(while
(setq obj(vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
(if (= (vlax-get-property obj 'isdynamicblock) :vlax-true)
(progn
(setq Ov(vlax-variant-value (vla-getdynamicblockproperties obj)))
(setq Os(vlax-safearray->list Ov))
(setq d(vlax-variant-value(vla-get-value (nth 0 Os))))
(vla-InsertRows objtable numrows 50.0 1)
(vla-SetTextHeight Objtable (+ acDataRow) 15)
(vla-SetAlignment Objtable acDataRow acMiddleCenter)
(vla-settext objtable numrows 0  (rtos d 2 2))
(setq numrows (+ numrows 1))
)
(alert "pick again not Select a Valid Block")
)
);While
(vlax-release-object objtable)
(princ)
); defun

Carlos Calderon G

>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

ancrayzy · ‎12-21-2021

Thank you @calderg1000, can you help me again.
It still not work for me, I loader the lisp but my Cad say "Unknown command" 😄

ancrayzy · ‎12-21-2021

The code missing "(" at row : vl-load-com) 😄

It work now but can you give some more optimization for it following below matters:

1. Allow user select multi blocks by dragging to make a selection.

2. Merge (sum) result with the same value into the a row.

3. Remove 2 decimal value.

4. Add 1 layer column to result table to separete the block with difference layer, this is great.
5. Ignore block with ATT text (if possible).

The table may be see like my attached files.

Regards

aaron_gonzalez · ‎06-23-2023

Hi Calderg,

I tried to update this lisp as last coment, buy i can´t to do., can you help us, please

; simple single column table

; By Alan H Aug 2019

; Edited to get the length property of a dynamic block

; calderg1000 Dic. 2021

(vl-load-com)

(defun c:List_length_dyn ( / total selectionset count intger selectionsetname obj_name pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable blk prp)

(defun LM:Dbl ( / pt1 numrows numcolumns rowheight colwidth ent doc curspace obj objtable blk prp)

(setq prp (strcase prp))

(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))

(vlax-invoke blk 'getdynamicblockproperties)

)

(if (setq total 0

selectionset

(ssget '((0 . "INSERT")

(-4 . "<or")

(2 . "`*U*")

(2 . "_P1000")

(2 . "HLS 50")

(-4 . "or>")

)

(progn

(setq count (sslength selectionset))

(setq doc (vla-get-activedocument (vlax-get-acad-object)))

(setq curspace (vla-get-modelspace doc))

(setvar 'ctablestyle "Standard")

(command "_.dimstyle" "_restore" "Standard")

(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table: ")))

(setq numrows 2)

(setq numcolumns 3)

(setq rowheight 50)

(setq colwidth 300)

(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))

(vla-settext objtable 0 0 "LENGTH TABLE")

(vla-settext objtable 1 0 "Bloque")

(vla-settext objtable 1 1 "Cantidad")

(vla-settext objtable 1 2 "Length")

(vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 20)

(setq objtable (vlax-ename->vla-object (entlast)))

(repeat (setq intger (sslength selectionset))

(setq selectionsetname

(ssname selectionset

(setq intger (1- intger))

)

obj (vlax-ename->vla-object selectionsetname)

Ov (vlax-variant-value (vla-getdynamicblockproperties obj))

Os (vlax-safearray->list Ov))

d (vlax-variant-value(vla-get-value (nth 0 Os)))

total (+ total (d)

)

(vla-InsertRows objtable numrows 50.0 1)

(vla-SetTextHeight Objtable (+ acDataRow) 15)

(vla-SetAlignment Objtable acDataRow acMiddleCenter)

;(vla-settext objtable numrows 0 selectionsetname)

(vla-settext objtable numrows 1 (rtos count 2 2))

(vla-settext objtable numrows 2 (rtos total 2 2))

(setq numrows (+ numrows 1))

); end if

(princ)

))

Sea-Haven · ‎06-23-2023

Some of that code is mine, can see need a sort based on layer name, it would also be better to use property "Length" rather than (nth 0 props) in case more items get added or order is changed.

Ok 1st step is make a table that matches your dwg as the object is lines and mtext.

Needs dbl sort and count functions. Will add to my to do list but may be a couple of days some one else may jump in.

A start

(defun c:wow ( / )

(setq txtht 120)

(Setq curspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

(setq sp (vlax-3d-point (getpoint "pick a point for table ")))

(setq objtable (vla-addtable curspace sp 3 3 200 500))
(vla-SetTextHeight Objtable acDataRow txtht)
(vla-SetTextHeight Objtable acHeaderRow (* txtht 1.2))
(vla-SetTextHeight Objtable acTitleRow (* txtht 1.5))
(vla-put-VertCellMargin Objtable (* txtht 0.5))
(vla-put-HorzCellMargin Objtable (* txtht 0.5))
(vla-Setcolumnwidth Objtable 0 1800)
(vla-Setcolumnwidth Objtable 1 1800)
(vla-Setcolumnwidth Objtable 2 1800)
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))
(vla-SetAlignment Objtable (+ acDataRow acHeaderRow acTitleRow)  acMiddleCenter)
(vla-settext objtable 0 0 "LENGTH TABLE")
(vla-settext objtable 1 0 "Length")
(vla-settext objtable 1 1 "Count")
(vla-settext objtable 1 2 "Layer name")
(princ)
)

Sea-Haven · ‎06-25-2023

I forgot need a dwg to look at.

aaron_gonzalez · ‎07-06-2023

Sea-Haven, I appreciate your support, the drawing is the same as shown above Count dynamic block.dwg (MESSAGE 8 OF 11) thank you very much

Sea-Haven · ‎08-13-2023

Try this.

; By Alan H Aug 2023

;; Thanks to Lee-mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

; By Gile
(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun CreateTableStyle( / dicts dictobj key class custobj )
(setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object))))
(setq dictObj (vla-Item dicts "acad_tablestyle"))
(vlax-for dname dictobj
(if (=  (vla-get-name dname) "Arrontable" ) ; does it exist
(Princ "Arrontable found")
(progn
  (setq txtht (getreal "\nEnter text height "))
  (setq key "Arrontable" class "AcDbTableStyle")
  (setq custObj (vla-AddObject dictObj key class))
  (vla-put-Name custObj "Arrontable")
  (vla-put-Description custObj "Arron custom table style")
  (vla-put-BitFlags custObj 1)
  (vla-put-FlowDirection custObj acTableTopToBottom)
  (vla-put-HorzCellMargin custObj (* txtht 0.5))
  (vla-put-VertCellMargin custObj (* txtht 0.5))
  (vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)
  (vla-SetTextHeight custObj acDataRow txtht)
  (vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
  (vla-SetTextHeight custObj acTitleRow (* txtht 1.5))
  (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")
  (setvar 'ctablestyle "Arrontable")
)
)
)
(princ)
) ; CreateTableStyle

(defun c:arrontable ( / ss lst lst2 lst3 obj len lay val cnt numrows)
(prompt "Pick the objects ")
(setq ss (ssget '((0 . "Insert"))))
(setq lst '())
(repeat (setq x (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
  (setq len (LM:getdynpropvalue obj "Length"))
  (setq lay (vlax-get obj 'Layer))
  (setq lst (cons (list lay len) lst))
)
(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
	    )
	  )
      )
)

(setq lst3 '())
(setq lst2 (remove_doubles lst))
(foreach val lst2
  (setq cnt (my-count  val lst))
  (setq lst3 (cons (list  (nth 0 val)(nth 1 val) cnt) lst3))
)
(setq lst3 (reverse lst3))

(CreateTableStyle)

(command "-Table" 3 1 (getpoint "\npick point for table "))
(setq objtable (vlax-ename->vla-object (entlast)))
(vla-Setcolumnwidth objtable 0 (* 15 txtht))
(vla-Setcolumnwidth objtable 1 (* 15 txtht))
(vla-Setcolumnwidth objtable 2 (* 15 txtht))
(vla-settext objtable 0 0 "LENGTH TABLE" )
(vla-settext objtable 1 0 "Length")
(vla-settext objtable 1 1 "Count")
(vla-settext objtable 1 2 "Layer name")

(setq numrows 2)
(foreach cell lst3
(vla-InsertRows Objtable  numrows (vla-GetRowHeight Objtable (1- numrows)) 1)
 (vla-settext objtable numrows 0 (cadr cell))
 (vla-settext objtable numrows 1 (caddr cell))
 (vla-settext objtable numrows 2 (car cell))
 (setq numrows (1+ numrows))
)

(princ)
)

Community

Get length of dimension on a block lisp

Get length of dimension on a block lisp

Get length of dimension on a block lisp