Copy line length and paste it in a block attribute

September 25, 2013

Hello.

Basically (or not) what i need to do is to copy the length of a line/polyline (usualy a line), and than paste the line length in an attribute called METROS_TOTAL of a block called IDENTIFICACAO_CABO. Is it possible?

In a big project, i have hundreds of this situations where i need to do this.

The start/end of a line always match the insertion point of one IDENTIFICACAO_CABO block. If miracles do exist , the lisp code would search all those lines and past their length to a IDENTIFICACAO_CABO block matching the same insertion point.

Is any of those things possible?

Thanks in advance

LineLength2BlockAttribute.dxf

September 25, 2013

The following will only work with lines (if you can explode the polylines)

I'm not sure how to incorporate polylines and anonymous block names; perhaps someone with more experience can add on?


********* REVISED CODE ON PAGE 2 *********

;;;;;;;;;
;;; 2013 Che Syn
;;; L2B - Adding line length to corresponding block
;;;;;;;;;
(defun c:l2b ( / bs bn be bx bi a ax ls le lx l1 l2 ld)
   (if
       (setq bs (ssget "_x" '( (0 . "INSERT")(8 . "50_BLOCO_ID_Cabo_DROP")(66 . 1) ))
             bn 0
       )
       (progn
           (while
               (< bn (sslength bs))
               (setq be (ssname bs 0)
                     bx (entget be)
                     bi (cdr (assoc 10 bx))
                     a (entnext be)
                     ax (entget a)
               )
                   (if
                       (setq ls (ssget "_x" (list
                                                '(0 . "LINE")
                                                '(8 . "50_CABO_ADSS_2")
                                                '(-4 . "<OR") (cons 10 bi)(cons 11 bi) '(-4 . "OR>")
                                            ))
                             le (ssname ls 0)
                             lx (entget le)
                             l1 (cdr (assoc 10 lx))
                             l2 (cdr (assoc 11 lx))
                             ld (rtos (distance l1 l2) 2 0)
                       )
                       (progn
                           (while
                               (/= "SEQEND" (cdr (assoc 0 ax)) )
                               (if
                                   (= "METROS_TOTAL" (cdr (assoc 2 ax)) )
                                   (progn
                                       (entmod
                                           (subst
                                               (cons 1 ld)
                                               (assoc 1 ax)
                                               ax
                                           )
                                       )
                                     (entupd be)
                                   )
                               )
                               (setq a (entnext a)
                                     ax (entget a)
                               )
                           )
                       )
                       (princ "\nNo lines found")
                   )
               (setq bn (1+ bn))
           )
       )
       (princ "\nNo blocks found")
   )
 (princ)
)

Edited September 26, 2013 by CheSyn

September 25, 2013

check if this works for you. Only works with line.

You are walking on a dangerous road by doing this method.

Why not pick the line and the block?

(defun C:test (/ i ssl ssb)
;;jdiala 09-25-2013
(if
 (setq ssb (ssget "_X" '((0 . "INSERT") (2 . "IDENTIFICACAO_CABO"))))

(repeat (setq i (sslength ssb))
 (setq i (1- i) 
      ssl nil
      ssl (ssget "_x" 
         (list 
		   (cons 0 "LINE") 
		     (cons -4 "<OR") 
			   (cons 10 (cdr (assoc 10 (entget (ssname ssb i))))) 
			   (cons 11 (cdr (assoc 10 (entget (ssname ssb i))))) 
			 (cons -4 "OR>")
	      )
		) 
 )

(if (= (sslength ssl) 1)
(LM:setattributevalue (ssname ssb i) "METROS_TOTAL" (rtos (distance (cdr (assoc 10 (entget (ssname ssl 0)))) (cdr (assoc 11 (entget (ssname ssl 0))))) ))
)

)
)
(princ)
)

;; Set Attribute Value  -  Lee Mac
;; http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc
(defun LM:setattributevalue ( blk tag val / end enx )
   (while
       (and
           (null end)
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   (setq end val)
               )
           )
       )
   )
)

September 26, 2013

My version.


(defun c:test ( / obj blk n e L p1 p2 Lv b p)
   (vl-load-com)
   (if
       (and
           (setq obj (ssget "_X" '((0 . "*LINE"))))
           (setq blk (ssget "_X" '((0 . "INSERT"))))
       )
       (progn           
           (repeat (setq n (sslength obj))
               (setq e (vlax-ename->vla-object (ssname obj (setq n (1- n))))
                     L (vla-get-length e)
                     p1 (vlax-curve-getEndPoint e)
                     p2 (vlax-curve-getStartPoint e)
                     Lv (cons (list p1 L) Lv)
                     Lv (cons (list p2 L) Lv)
               )
           )

           (repeat (setq n (sslength blk))
               (setq b (ssname blk (setq n (1- n))))
               (if (= (vla-get-effectivename (vlax-ename->vla-object b))"IDENTIFICACAO_CABO" )
                   (progn
                       (setq p (cdr (assoc 10 (entget b))))
                       (mapcar
                           '(lambda (x)
                                    (if (equal p (car x) 1e-5)
                                        (LM:setattributevalue b "METROS_TOTAL" (rtos (cadr x)))
                                    )
                            )
                           Lv
                       )
                   )
               )
           )
       )
   )
)


;; Set Attribute Value  -  Lee Mac
;; [url]http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc[/url]
(defun LM:setattributevalue ( blk tag val / end enx )
   (while
       (and
           (null end)
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   (setq end val)
               )
           )
       )
   )
)

p.s.: the OP has fled?

September 26, 2013

Hello dear jdiala

I've tried to use your lisp code too, added it with sucess to AutoCAD Civil 3D 2012 and to an AUTOCAD MAP 2007 but in the command line i get:

Command: (LOAD "C:/Users/CarlosCardoso/Desktop/DST/test.lsp")

LM:SETATTRIBUTEVALUE

and then i can't use it, or call the test funcion.

Thanks for your kindly help too

September 26, 2013

Here is my version , try it and let me know

(defun c:Test (/ ss i sn vl j k p1 p2 s n x st nd p e)
 ;; Author : Tharwat Al Shoufi 26.Sep.2013    ;;
 (if (setq
       ss (ssget "_X"
                 (list '(0 . "INSERT")
                       (cons 2 (strcat "`*U*," "IDENTIFICACAO_CABO"))
                 )
          )
     )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (if (eq (vla-get-effectivename
               (setq vl (vlax-ename->vla-object sn))
             )
             "IDENTIFICACAO_CABO"
         )
       (progn
         (vla-getboundingbox vl 'j 'k)
         (setq p1 (vlax-safearray->list k)
               p2 (vlax-safearray->list j)
         )
         (if (or (setq s (ssget "_F"
                                (list p1
                                      (list (car p1) (cadr p2) 0.)
                                      p2
                                      (list (car p2) (cadr p1) 0.)
                                )
                                '((0 . "LINE,LWPOLYLINE"))
                         )
                 )
                 (setq s (ssget "_WP"
                                (list p1
                                      (list (car p1) (cadr p2) 0.)
                                      p2
                                      (list (car p2) (cadr p1) 0.)
                                )
                                '((0 . "LINE,LWPOLYLINE"))
                         )
                 )
             )
           (repeat (setq n (sslength s))
             (setq x  (ssname s (setq n (1- n)))
                   st (vlax-curve-getstartpoint x)
                   nd (vlax-curve-getendpoint x)
                   p  (cdr (assoc 10 (entget sn)))
             )
             (if (or (equal st p 1e- (equal nd p 1e-)
               (while
                 (and (setq sn (entnext sn))
                      (/= (cdr (assoc 0 (setq e (entget sn)))) "SEQEND")
                 )
                  (if (eq (strcase (cdr (assoc 2 e))) "METROS_TOTAL")
                    (entmod
                      (subst
                        (cons 1
                              (rtos (vlax-curve-getdistatpoint x nd) 2 4)
                        )
                        (assoc 1 e)
                        e
                      )
                    )
                  )
               )
             )
           )
         )
       )
     )
   )
 )
 (princ)
)
(vl-load-com)

Edited September 26, 2013 by Tharwat

September 26, 2013

Hello dear jdiala
I've tried to use your lisp code too, added it with sucess to AutoCAD Civil 3D 2012 and to an AUTOCAD MAP 2007 but in the command line i get:

Command: (LOAD "C:/Users/CarlosCardoso/Desktop/DST/test.lsp")

LM:SETATTRIBUTEVALUE

and then i can't use it, or call the test funcion.

Thanks for your kindly help too

Did you try mine?

September 26, 2013

Did you try mine?

You may need to add the LWPOLYLINE entity to your selection set for lines besides that a few of extra lines of codes should be added for the new entity type

September 26, 2013

You may need to add the LWPOLYLINE entity to your selection set for lines besides that a few of extra lines of codes should be added for the new entity type

I tried LWPOLYLINE and could select them; however, I had trouble finding the length (DXF 11 for the end point returned nil). Is there a way to do this with Vanilla LISP, I'm assuming DXF 11 is incorrect?

Furthermore, I tried selecting the block based on name (DXF 2), but was unable due to the anonymous naming - any tips how to get around this?

September 26, 2013

I tried LWPOLYLINE and could select them; however, I had trouble finding the length (DXF 11 for the end point returned nil). Is there a way to do this with Vanilla LISP, I'm assuming DXF 11 is incorrect?

Unfortunately there is not , either with function vlax-curve-***** or with vla-get-length function .

Furthermore, I tried selecting the block based on name (DXF 2), but was unable due to the anonymous naming - any tips how to get around this?

Take a close look at my code to know how to filter Dynamic Blocks with the function ssget .

September 26, 2013

Hello CheSyn

I've tried to use your lisp code, added it with sucess to AutoCAD Civil 3D 2012 and to an AUTOCAD MAP 2007 but it throw the following error, so i can't test it successfully.

Command: Command: (LOAD "C:/Users/CarlosCardoso/Desktop/DST/l2b.lsp") C:L2B

Command: L2B

; error: bad argument type: lselsetp nil

Thanks for your kindly help

September 26, 2013

My version.


(defun c:test ( / obj blk n e L p1 p2 Lv b p)
   (vl-load-com)
   (if
       (and
           (setq obj (ssget "_X" '((0 . "*LINE"))))
           (setq blk (ssget "_X" '((0 . "INSERT"))))
       )
       (progn           
           (repeat (setq n (sslength obj))
               (setq e (vlax-ename->vla-object (ssname obj (setq n (1- n))))
                     L (vla-get-length e)
                     p1 (vlax-curve-getEndPoint e)
                     p2 (vlax-curve-getStartPoint e)
                     Lv (cons (list p1 L) Lv)
                     Lv (cons (list p2 L) Lv)
               )
           )

           (repeat (setq n (sslength blk))
               (setq b (ssname blk (setq n (1- n))))
               (if (= (vla-get-effectivename (vlax-ename->vla-object b))"IDENTIFICACAO_CABO" )
                   (progn
                       (setq p (cdr (assoc 10 (entget b))))
                       (mapcar
                           '(lambda (x)
                                    (if (equal p (car x) 1e-5)
                                        (LM:setattributevalue b "METROS_TOTAL" (rtos (cadr x)))
                                    )
                            )
                           Lv
                       )
                   )
               )
           )
       )
   )
)


;; Set Attribute Value  -  Lee Mac
;; [url]http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc[/url]
(defun LM:setattributevalue ( blk tag val / end enx )
   (while
       (and
           (null end)
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   (setq end val)
               )
           )
       )
   )
)

p.s.: the OP has fled?

Hello GP_, your lisp code is awesome! Work pretty well. Tried it in about one hundred lines/blocks, and it took about 2 seconds to complete.

THANKS a MILLION

Sorry, i didn't understand what you mean with "the OP has fled?". Can you please tell explain what you mean?

Thanks again

September 26, 2013

Hello Tharwat.

First, thanks for your help.

I tried your code, it works great with the first object (read line length and insert it to the block), but than it stops. I tried to select all first, and than tried to select a few sets but it won't fill any more objects.

Thanks for your kindly help

September 26, 2013

Hello cmscardoso, please try the revised code below and let me know how it works (it works perfectly in the example file you posted)!

;;;;;;;;;
;;; 2013 Che Syn
;;; L2B - Adding line length to corresponding block
;;;;;;;;;
(defun c:l2b ( / bs bn be bx bi a ax ls le lx l1 l2 ld)
   (if
       (setq bs (ssget "_x" (list
                                '(0 . "INSERT")
                                (cons 2 (strcat "`*U*," "IDENTIFICACAO_CABO"))
                                '(8 . "50_BLOCO_ID_Cabo_DROP")
                            ))
             bn 0
       )
       (progn
           (while
               (< bn (sslength bs))
               (setq be (ssname bs bn)
                     bx (entget be)
                     bi (cdr (assoc 10 bx))
                     a (entnext be)
                     ax (entget a)
               )
                   (if
                       (setq ls (ssget "_x" (list
                                                '(0 . "LINE,LWPOLYLINE")
                                                '(8 . "50_CABO_ADSS_2")
                                                '(-4 . "<OR") (cons 10 bi)(cons 11 bi) '(-4 . "OR>")
                                            ))
                             le (ssname ls 0)
                             lx (entget le)
                       )
                       (progn
                           (if
                               (= "LINE" (cdr (assoc 0 lx)) )
                               (setq l1 (cdr (assoc 10 lx))
                                     l2 (cdr (assoc 11 lx))
                                     ld (rtos (distance l1 l2) 2 0)
                               )
                               (setq l1 (cdr (assoc 10 lx))
                                     l2 (cdr (assoc 10 (reverse lx)))
                                     ld (rtos (distance l1 l2) 2 0)
                               )
                           )
                           (while
                               (/= "SEQEND" (cdr (assoc 0 ax)) )
                               (if
                                   (= "METROS_TOTAL" (cdr (assoc 2 ax)) )
                                   (progn
                                       (entmod
                                           (subst
                                               (cons 1 ld)
                                               (assoc 1 ax)
                                               ax
                                           )
                                       )
                                     (entupd be)
                                   )
                               )
                               (setq a (entnext a)
                                     ax (entget a)
                               )
                           )
                       )
                       (princ "\nNo lines found")
                   )
               (setq bn (1+ bn))
           )
       )
       (princ "\nNo blocks found")
   )
 (princ)
)

Tharwat, thank you for the tip with anonymous block names.

I found a way to make polylines work in Vanilla LISP (Visual still scares me ), please see the above code.

Edited September 26, 2013 by CheSyn

September 26, 2013

Hello CheSyn.

Now it works perfectly. Tried it again, in a few sets (line+block) and worked awesome.

BIG BIG thanks

September 26, 2013

You're welcome. This was actually fun to write.

September 26, 2013

Hello Tharwat.
First, thanks for your help.

You're welcome .

but than it stops. I tried to select all first, and than tried to select a few sets but it won't fill any more objects.

You don't have to select anything at all and that's odd that you got it working and on the second time it won't !

Close the drawing then open it again , after that run my codes then to check the code again just change the size of the lines or LWpolylines to see

the changes on Attributed blocks though I recommend that you run the code on a few block with zoom in to screen to see the changes on the fly .

I added a few lines of code , try it and let me know .

September 26, 2013

Tharwat, thank you for the tip with anonymous block names.

You're welcome anytime

I found a way to make polylines work in Vanilla LISP (Visual still scares me ), please see the above code.

That works if a LWpolyline has only two vertices besides that, there is no need to include the DXF 66 with Dynamic Blocks even if it has Attributes

September 26, 2013

That works if a LWpolyline has only two vertices besides that, there is no need to include the DXF 66 with Dynamic Blocks even if it has Attributes

That is correct, I should have mentioned this will only work with two vertices (I assume stepping through with entnext could work to find others?). I did not realize DXF 66 was not needed, and have revised the code above.

September 26, 2013

@CheSyn

(distance l1 l2) does not work with polylines, lines only.

Tharwat, thank you for the tip with anonymous block names.

+1

New code, maybe faster.

(defun c:test ( / obj blk n e Lv b p)
   (vl-load-com)
   (if
       (and
           (setq obj (ssget "_X" '((0 . "*LINE"))))
           (setq blk (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat "`*U*," "IDENTIFICACAO_CABO")))))
       )
       (progn           
           (repeat (setq n (sslength obj))
               (setq e (vlax-ename->vla-object (ssname obj (setq n (1- n))))
                     Lv (cons (list (vlax-curve-getEndPoint e) (vla-get-length e)) Lv)
                     Lv (cons (list (vlax-curve-getStartPoint e) (vla-get-length e)) Lv)
               )
           )
           (repeat (setq n (sslength blk))
               (setq b (ssname blk (setq n (1- n))))
               (mapcar
                   '(lambda (x)
                        (if (equal (cdr (assoc 10 (entget b))) (car x) 1e-5)
                            (LM:setattributevalue b "METROS_TOTAL" (rtos (cadr x)))
                        )
                    )
                   Lv
               )
           )
       )
   )
)

;; Set Attribute Value  -  Lee Mac
;; [url]http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc[/url]
(defun LM:setattributevalue ( blk tag val / end enx )
   (while
       (and
           (null end)
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   (setq end val)
               )
           )
       )
   )
)

Sign In

Copy line length and paste it in a block attribute

Recommended Posts

cmscardoso

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

CheSyn

jdiala

GP_

cmscardoso

Tharwat

CheSyn

Tharwat

CheSyn

Tharwat

cmscardoso

cmscardoso

cmscardoso

CheSyn

cmscardoso

CheSyn

Tharwat

Tharwat

CheSyn

GP_

Join the conversation

Tutorials

Forums

Activity