Jump to content

Get length of dimension on a block lisp

ancrayzy

By ancrayzy
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ancrayzy Rookie

ancrayzy

Posted
Posted (edited)

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

 

Capture2.PNG

Get lenght.dwg

Edited by ancrayzy
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted (edited)

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 by ancrayzy
Tharwat Grand Master

Tharwat

Posted
Posted

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.

  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted

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.

  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted

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 Grand Master

BIGAL

Posted
Posted

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.

  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted

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

Capture5.PNG

Count dynamic block.dwg

Steven P Grand Master

Steven P

Posted
Posted

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
            )
        )
    )
)

 

  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted

Thanks for your help @Steven P

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

Steven P Grand Master

Steven P

Posted
Posted (edited)
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 by Steven P
  • Like 1
Tharwat Grand Master

Tharwat

Posted
Posted

@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.

  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted

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 Grand Master

Steven P

Posted
Posted

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

  • Like 1
ancrayzy Rookie

ancrayzy

Posted
  • Author
Posted

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...