Get length of dimension on a block lisp

[ancrayzy]

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

 

Get lenght.dwg

Edited December 20, 2021 by ancrayzy

[BIGAL]

If its a dynamic block then it has a length property, I did not open dwg, download Lee-mac dynamic block properties lisp and it has code to get the L=3000, just need to know property name.

Edited December 22, 2021 by BIGAL

[ancrayzy]

Thank for your help  @BIGAL

I find here many set of functions, but i don't know how to use these useful codes.

Can you give me more details on how to use these codes?

I tried to add "c:" after defun but it didn't work.

For example

;; Get Dynamic Block Property Value  -  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 C: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)
    )
)

 

Edited December 22, 2021 by ancrayzy

[Tharwat]

You need to make a selection set then change the entity to vla-object then from the previously posted function you can get the length property once you feed the correct arguments as described in the function.

[BIGAL]

As Tharwat has suggested, an example, single pick, where the dynamic property name is "Length" 

 

(setq blk (vlax-ename->vla-object (car  (entsel "Pick block"))))
(setq len (LM:getdynpropvalue blk "Length"))

 

Your task is to use a selection set instead plenty of examples here.

[ancrayzy]

Dear Tharwat , BIGAL

Many thank for you help, can you give me a finished lisp.

I need learning to have more knowlege about coding to using your suggestions 

[BIGAL]

To many unanswered questions, do you want how many are 3000 long, choose by Layer or sort by layer, what does table look like to mention a few.

[ancrayzy]

Thanks for your time @BIGAL

The finish maybe like the attached files.

For example:

1. Type command

2. Get selection objects, ignore block with ATT text (if possible).

3. Give option to chose text height for table or make by the current table style of the drawing.

Regards

Count dynamic block.dwg

[Steven P]

Copying and pasting from what I have, this will get you  the dimension - might be a long way round but it gave e "L=3000" from your example drawing. You have to select each dimension that you want.

 

Now all you need is how to get the value from this single selected dimension and put it into a table, do you want to modify an existing table or create a new table from a list of selected dimensions?

 

I've also copied in Lee Macs Unformat LISP - from his website and I would always recommend going there to get the latest version rather than what is below

 

 

(defun c:dynamicdimtext ( / )
  (defun getfroment (ent entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
    (setq entlist (entget ent))
    (setq acount 0)
    (while (< acount (length entlist))
      (setq acounter 0)
      (while (< acounter (length entcodes))
        (setq entcode (nth acounter entcodes))
        (if (= (car (nth acount entlist)) entcode )
          (progn
            (setq newtext (cdr (nth acount entlist)))
            (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
            (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
          );end progn
        );end if
        (setq acounter (+ acounter 1))
      );end while
      (setq acount (+ acount 1))
    );end while
  ;;get string from dotted pair lists
        (if (> (length mytext) 0)
          (progn
            (setq acount 0)
            (setq temptext "")
            (while (< acount (length mytext))
              (setq temptext (cdr (nth acount mytext)) )
              (if (= stringtext nil)
                (setq stringtext temptext)
                (setq stringtext (strcat stringtext temptext ))
              );end if
              (setq acount (+ acount 1))
            );end while
          );end progn
        );end if
        (if (= stringtext nil)(setq stringtext ""))
        (setq mytext stringtext)
    mytext
  )

;;get text as a string
   (defun gettextasstring ( enta entcodes / texta )
    (if (= (getfroment enta entcodes) "")
      ()
      (setq texta (getfroment enta entcodes))
    )
    texta
  )

;;get text 1
  (setq ent1 (getent "\nSelect Dimension : "))
  (setq entlist1 (entget ent1))
  (setq entcodes1 (list 4 1 172 304))
  (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
  (setq text01 (LM:UnFormat text01 "" ))

(princ text01)

)





;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;
(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

[ancrayzy]

Thanks for your help @Steven P

I tried this code but it didn't work. Nothing happen after enter command "dynamicdimtext"

[Steven P]

26 minutes ago, ancrayzy said:

Thanks for your help @Steven P

I tried this code but it didn't work. Nothing happen after enter command "dynamicdimtext"

 

 

The one bit I keep forgetting... add this code in after the first line and see what it does

 

  (defun getent ( aprompt / enta entb pt )
    (princ "\n")
    (setq enta (car (nentsel aprompt)))
    (setq pt (cdr (assoc 10 (entget enta))) )
  
;;;;fix for nenset or entsel requirements
    (setq entb (last (last (nentselp pt))))
  
    (if (and (/= entb nil) (/= (type entb) 'real) )
      (progn
        (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION")(setq enta entb))
      )
    )
    enta
  )

 

 

It should now be and your dimension will be shown in the command line text01 in this LISP ready to add to a table

 

(defun c:dynamicdimtext ( / ent1 entcodes1 entlist1 text01 )
  (defun getent ( aprompt / enta entb pt )
    (princ "\n")
    (setq enta (car (nentsel aprompt)))
    (setq pt (cdr (assoc 10 (entget enta))) )
  
;;;;fix for nenset or entsel requirements
    (setq entb (last (last (nentselp pt))))
  
    (if (and (/= entb nil) (/= (type entb) 'real) )
      (progn
        (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION")(setq enta entb))
      )
    )
    enta
  )

  (defun getfroment (ent entcodes / acount acounter mytext newtext stringtext)
  ;;get dotted pairs list
    (setq entlist (entget ent))
    (setq acount 0)
    (while (< acount (length entlist))
      (setq acounter 0)
      (while (< acounter (length entcodes))
        (setq entcode (nth acounter entcodes))
        (if (= (car (nth acount entlist)) entcode )
          (progn
            (setq newtext (cdr (nth acount entlist)))
            (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
            (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
          );end progn
        );end if
        (setq acounter (+ acounter 1))
      );end while
      (setq acount (+ acount 1))
    );end while
  ;;get string from dotted pair lists
        (if (> (length mytext) 0)
          (progn
            (setq acount 0)
            (setq temptext "")
            (while (< acount (length mytext))
              (setq temptext (cdr (nth acount mytext)) )
              (if (= stringtext nil)
                (setq stringtext temptext)
                (setq stringtext (strcat stringtext temptext ))
              );end if
              (setq acount (+ acount 1))
            );end while
          );end progn
        );end if
        (if (= stringtext nil)(setq stringtext ""))
        (setq mytext stringtext)
    mytext
  )

;;get text as a string
   (defun gettextasstring ( enta entcodes / texta )
    (if (= (getfroment enta entcodes) "")
      ()
      (setq texta (getfroment enta entcodes))
    )
    texta
  )

;;get text 1
  (setq ent1 (getent "\nSelect Dimension : "))
  (setq entlist1 (entget ent1))
  (setq entcodes1 (list 4 1 172 304))
  (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
  (setq text01 (LM:UnFormat text01 "" ))

(princ text01)

)





;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;
(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

Edited December 23, 2021 by Steven P

[Tharwat]

@ancrayzy what you are asking for is a custom program and not codes to learn from so you asked how to get lengths of dynamic blocks and I guided you how to make it and @BIGAL gathered the codes for you to start from then you are now talking about table , dimensions, ... etc. which means full program.

Contact me if you can pay for the program.

[ancrayzy]

Thank you so much @Steven P, the code still not work.

Select Dimension : L=3000"L=3000"
Command:
Command:  DYNAMICDIMTEXT
Select Dimension : nilnil

@TharwatThank you for reminding me, then I would like to stop my request and when I can afford to pay I will buy the program from community.

Again, thank for all your time and help.

Regards.

[Steven P]

Just to check that you were selecting the dimension, or other text, rather than some other point or object such as a line

[ancrayzy]

I tried to select dimension and even dynamic block but it still not any thing happen