Combine multiple Line length and existing text in one attribute block

[tarektm]

Hello,

 

i have a case where i should Combine multiple Line length and existing text in one attribute block,

 

Here is an example.

 

i have two lines, one of them only have text, so if i select the three elements (two lines and the text) the lisp have to create an attribute block as shown underneath the lines

 

___300x200____------------

 

width: 300

depth: 200

Length: (Line1 length+Line2 length)

 

This attribute block should be saved in a new layer, let's say i will name it M-Duct-Calc

 

The purpose of this lisp is to measure the ducting length to create quantity estimation.

 

Any help or guidance is Highly Appreciated.

[tarektm]

I don't know if this is allowed in this forum, but i am ready to pay for this also.

[Tharwat]

I don't know if this is allowed in this forum, but i am ready to pay for this also.

There is no need to pay for this , just no body replied to your thread due to lack of information to write the lisp for you .

[tarektm]

There is no need to pay for this , just no body replied to your thread due to lack of information to write the lisp for you .

 

Hello, Mr. Tharwat and Thanks for reply "Ebn Al Balad :)"

[Tharwat]

[quote name=tarekt

m] "Ebn Al Balad :)"

Waw

 

Welcome to Cadtutor Tarek

 

I guess it is better to upload a sample drawing showing before and after of your aim of the lisp , and I would be more than happy to write the

lisp ( if I could make it or if it is possible ) .

 

Regards

[tarektm]

Waw

 

Welcome to Cadtutor Tarek

 

I guess it is better to upload a sample drawing showing before and after of your aim of the lisp , and I would be more than happy to write the

lisp ( if I could make it or if it is possible ) .

 

Regards

 

Thank you for The Warm Welcome Tharwat

I Attached a descriptive drawing explaining what i need, in case there is any doubts, please let me know.

lisp_disc.dwg

[Tharwat]

Tarek , Here is in the attached drawing one Attributed Block named :MyAttributedBlock and you can rename it or recreate your own one but don't forget to the change the Block Name in the routine as well , and I hope the following lisp would work as required .

 

Note: The drawing that you have attached is made by another Autocad Arch. so I am not sure that the lisp could work on the other Cad versions due to the DXF codes .

 

(defun c:Test  (/ BlkName *error* ad IsAttributed l ss s p w d str st g  ent)
;;;===---{ Author : Tharwat Al Shoufi }---===;;;
;;;===---{ Date   : 20. May. 2013     }---===;;;
 (defun *error* (x)
   (if ad
     (setvar 'attdia ad)
   )
   (if st
     (entdel st)
   )
   (princ "\n*Cancel*")
 )
 (setq BlkName "MyAttributedBlock")    ; Name of the Attributed Block ;

 (setq ad (getvar 'attdia))
 (setvar 'attdia 0)
 (or Doc
     (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun IsAttributed (Doc name / n)
   (setq n 0)
   (vlax-for o (vla-item (vla-get-blocks Doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq n (1+ n))
     )
   )
   n
 )
 (cond
   ((eq 4
        (logand
          4
          (cdr
            (assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer))))
          )
        )
    )
    (progn (alert "Current Layer is LOCKED !!") (exit))
   )
   ((not (tblsearch "BLOCK" BlkName))
    (progn (alert (strcat "The Attributed Block name < "
                          BlkNmae
                          " > is not found in the drawing !!"
                  )
           )
           (exit)
    )
   )
   ((not (eq (IsAttributed Doc BlkName) 3))
    (progn
      (alert
        (strcat
          "The Block name <"
          BlkName
          " > is not Attributed or doesn't have three attributes !!"
        )
      )
      (exit)
    )
   )
 )
 (if
   (and
     (progn (princ "\n Select lines to measure them :")
            (setq l  0.
                  ss (ssget '((0 . "LINE")))
            )
     )
     (progn (princ "\n Pick one Text only :")
            (setq s (ssget "_+.:S:E:L" '((0 . "*TEXT") (1 . "#*x*#"))))
     )
   )
    (progn
      ((lambda (j / sn e)
         (while (setq sn (ssname ss (setq j (1+ j))))
           (setq e (entget sn))
           (setq
             l (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
           )
         )
       )
        -1
      )
      (setq p (vl-string-search
                "x"
                (setq str (cdr (assoc 1 (entget (ssname s 0)))))
              )
            w (substr str 1 p)
            d (substr str (+ 2 p))
      )
      (command "_.-insert"
               BlkName
               "_none"
               "\\"
               "1.0"
               "0"
               (strcat "Length :" (rtos l 2 0))
               (strcat "Depth  :" d)
               (strcat "Width  :" w)                 
      )
      (setq st (entlast))
    )
 )
 (setvar 'attdia ad)
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)
(vl-load-com)

Test.dwg

[tarektm]

Mr. Tharwat, This works Great! you have a brilliant Mind!!! Wonderful Work, Thank you!

 

Nice to Know you, hope others find this helpful as well.

[Tharwat]

Mr. Tharwat, This works Great! you have a brilliant Mind!!! Wonderful Work, Thank you!

 

Nice to Know you, hope others find this helpful as well.

 

Excellent , You're very welcome Tarek

 

Thank you for the nice compliment .

[tarektm]

Excellent , You're very welcome Tarek

 

Thank you for the nice compliment .

 

Hello Again,

 

When i tested the file today i notices that i forgot all about Arcs, I should be able to Add the length of line and/or arcs, i could manage to add the arcs to the object list by changing this filter

ss (ssget '((0 . "LINE")))

to

ss (ssget '((0 . "LINE,ARC")))

But this was the easy part,

i was not able to manage to add the ARC Length To the SUM, i think this should go here if i am not wrong:

(progn
      ((lambda (j / sn e)
         (while (setq sn (ssname ss (setq j (1+ j))))
           (setq e (entget sn))
           (setq
             l (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
           )
         )
       )
        -1
      )

[Tharwat]

i was not able to manage to add the ARC Length To the SUM, i think this should go here if i am not wrong:

 

Try this ...

 

((lambda (j / sn e)
  (while (setq sn (ssname ss (setq j (1+ j))))
    (setq e (entget sn))
    (if (eq "LINE" (cdr (assoc 0 e)))
      (setq l (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e)))))
      (setq l (+ l (vla-get-arclength (vlax-ename->vla-object sn))))
    )
  )
)
 -1
)

[Lee Mac]

To avoid the conversion to a VLA-Object, you could alternatively make use of the relationship:

 

s = rθ

 

Where s is the arc-length, r is the arc radius & θ is the angle spanned by the arc.

[tarektm]

Perfect!

Thanks Once again, and i think we know each other in person. Remember Hamak? Unit 16 and 17?

[tarektm]

To avoid the conversion to a VLA-Object, you could alternatively make use of the relationship:

 

s = rθ

 

Where s is the arc-length, r is the arc radius & θ is the angle spanned by the arc.

 

Thanks for the Suggestion however i am still a beginner in Lisp and i think i did not got the benefits of avoiding the VLA-objects just yet.

I have too much to learn

[Tharwat]

To avoid the conversion to a VLA-Object, you could alternatively make use of the relationship:

 

s = rθ

 

Where s is the arc-length, r is the arc radius & θ is the angle spanned by the arc.

 

Okay , this is what I can come up with the formula .

 

(defun _ArcLength (s / e c p1 p2 l)
 (setq c  (cdr (assoc 10 (setq e (entget s))))
       p1 (vlax-curve-getstartpoint s)
       p2 (vlax-curve-getendpoint s)
       l  (/ (* (* (cdr (assoc 40 e)) 2.) pi)
             (/ 360. (- (angle c p2) (angle c p1)))
          )
 )
 (/ (* l 180.0) pi)
)

Hope to know your opinion about it .

 

Perfect!

Thanks Once again, and i think we know each other in person. Remember Hamak? Unit 16 and 17?

You're welcome ,

 

But I am sorry I don't know what you mean by Hamak and the unit 16 , 17 ?

[Lee Mac]

Hope to know your opinion about it .

 

A couple of points & suggestions:

 

 

• DXF Groups 50 & 51 already store the start & end angle for the arc, so there is no need to retrieve the center, start & end points in order to calculate these angles.
  

 

• The conversions to & from degrees is unnecessary.
  

 

• Test the function with an arc whose end points pass through the WCS X-Axis, e.g.:

  (_arclength (entmakex '((0 . "ARC") (10 0 0) (40 . 1.0) (50 . -0.5236) (51 . 3.6652))))

  
  

[tarektm]

Some notes while working,

 

Here i put a real example from my working file.

 

The notes are the lisp is not reading the TEXT but it works with MTEXT, second in the real mm file size the block comes so small,

 

i have some questions as shown in the attached drawing.

Dlen_lisp.dwg

[pBe]

To avoid the conversion to a VLA-Object, you could alternatively make use of the relationship:

 

s = rθ

 

Where s is the arc-length, r is the arc radius & θ is the angle spanned by the arc.

 

It's that easy eh? I'm liking the math approach LM.

[Tharwat]

The notes are the lisp is not reading the TEXT but it works with MTEXT, second in the real mm file size the block comes so small,

 

That was due to the Text string and not the Text or Mtext entity itself , I have modified the code to suit and take over this problem as the following .

 

i have some questions as shown in the attached drawing.

 

I have read the notes in a hurry but I think the answer is no up to now , but we may find another way to do the notes if you have explained your needs of these issues clearly and in a new thread of course .

 

And for the Block size , I think I have made the Block with the Units or cm and not mm , so just ignore it and create a new one with a new name and add it to the code .

 

Good luck

 

(defun c:Test (/ BlkName *error* ad IsAttributed l ss s p w d str st g  ent)
;;;===---{ Author : Tharwat Al Shoufi }---===;;;
;;;===---{ Date   : 20. May. 2013     }---===;;;
 (defun *error* (x)
   (if ad
     (setvar 'attdia ad)
   )
   (if st
     (entdel st)
   )
   (princ "\n*Cancel*")
 )
 (setq BlkName "MyAttributedBlock")    ; Name of the Attributed Block ;

 (setq ad (getvar 'attdia))
 (setvar 'attdia 0)
 (or Doc
     (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun IsAttributed (Doc name / n)
   (setq n 0)
   (vlax-for o (vla-item (vla-get-blocks Doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq n (1+ n))
     )
   )
   n
 )
 (cond
   ((eq 4
        (logand
          4
          (cdr
            (assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer))))
          )
        )
    )
    (progn (alert "Current Layer is LOCKED !!") (exit))
   )
   ((not (tblsearch "BLOCK" BlkName))
    (progn (alert (strcat "The Attributed Block name < "
                          BlkNmae
                          " > is not found in the drawing !!"
                  )
           )
           (exit)
    )
   )
   ((not (eq (IsAttributed Doc BlkName) 3))
    (progn
      (alert
        (strcat
          "The Block name <"
          BlkName
          " > is not Attributed or doesn't have three attributes !!"
        )
      )
      (exit)
    )
   )
 )
 (if
   (and
     (progn (princ "\n Select lines to measure them :")
            (setq l  0.
                  ss (ssget '((0 . "LINE,ARC")))
            )
     )
     (progn (princ "\n Pick one Text only :")
            (setq s (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
     )
   )
    (progn
      ((lambda (j / sn e)
         (while (setq sn (ssname ss (setq j (1+ j))))
           (setq e (entget sn))
           (if (eq "LINE" (cdr (assoc 0 e)))
             (setq l
                    (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
             )
             (setq l
                    (+ l (vla-get-arclength (vlax-ename->vla-object sn)))
             )
           )
         )
       )
        -1
      )
      (if (setq p (vl-string-search
                    "x"
                    (setq str (cdr (assoc 1 (entget (ssname s 0)))))
                  )
          )
        (progn
          (setq w (substr str 1 p)
                d (substr str (+ 2 p))
          )
          (command "_.-insert"
                   BlkName
                   "_none"
                   "\\"
                   "1.0"
                   "0"
                   (strcat "Length :" (rtos l 2 0))
                   (strcat "Depth  :" d)
                   (strcat "Width  :" w)
          )
          (setq st (entlast))
        )
        (cond
          ((or (not w) (not d))
           (alert
             "\n The Text string doesn't have the form of <100x100> !"
           )
          )
        )
      )
    )
 )
 (setvar 'attdia ad)
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)
(vl-load-com)

[Lee Mac]

It's that easy eh? I'm liking the math approach LM.

 

Such simplistic geometric relationships follow from the definition of the radian being the angle swept by an arc whose arc-length equals its radius - i.e. for every radian turned about the center, you are traversing a distance equal to the radius along the arc.