Can't get the lengths of the lines and polylines.

[j_spawn_h]

Ok guys i know i am doing something wrong here. I have been trying to get the length of the lines and polylines to a setq. Every time i add a line to get the length it seems to make the lisp fail. Right now it works the way i want it to,but then stops working when i add some lines in for lengths. I have looked at all types of lisp trying to add something in this to work. I looked at stuff from Lee MAc, afralisp, jefferypsanders, ect... I tried not to come here and ask y'all for help and do this one on my own, but just can't figure out what i am doing wrong.

 

                ;Version 1.00
(defun c:td (/ layerset hr raf1 raf2 ss en ed p10 p11 mpt d2d d1d d3d d4d lan tan fg hg)
(vl-load-com)
 (defun errorhandler (s)
   (if    (/= s "Function cancelled")
     (princ (strcat "\nError: " s))
     (princ "SW function cancelled!")
   )
   (setvar "clayer" layerset)
   (setvar "orthomode" orthoset)
   (setvar "osmode" osset)
   (setvar "cmddia" cmddiaset)
   (setvar "attdia" attdiaset)
   (setvar "regenmode" 1)
   (setq *error* olderr)
   (princ)
 )

(setq dscal (getvar "dimscale"))
(setq dimconv (/ 96.0 dscal))
(setq lspace (* 9.0 (/ dscal 96.0)))
(setq tfc12 (* 12.0 (/ dscal 96.0)))
;;;;----set variables -------------------------------------
 (setq layerset (getvar "clayer"))

 (command "_.layer" "s" "s-Fnd-Tbeam" "")
 (command "_.layer" "off" "*" "n" "")
 (command "_.layer" "on" "s-fnd-stend,s-fnd-btend,s-fnd-hstend,s-fnd-vstend,s-fnd-vbtend,s-fnd-hbtend" "")
 (command "textsize" "6" "")
 (command "_.style" "romans" "0" "0.80" "" "" "" "")
;;;;-----Get point for start side-------------------
 (setq dt (getstring "DBL(2) or TRPL(3) Tendons"))
 (setq arr (getpoint "Pick first side you want the Live end"))
   
     (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
    
    (setq ed (entget en))
    (setq lyr (cdr (assoc 8 ed)))
    (setq p10 (cdr (assoc 10 ed)))
    (setq p11 (cdr (assoc 11 ed)))
    (setq pln (cdr (assoc 90 ed)))
    (setq pp10 p10);first pline corrd for start placement
    (setq pp9 p11);second pline corrd for start rotation
    (setq pp11 p11);last pline corrd for end placement
    (setq pp12 p10);second to last corrd on miltiple plines for end rotation
    ;(setq distt1 (fix (/ (distance pp10 pp11) 12.0)))
     (if (= (cdr (assoc 0 ed)) "LWPOLYLINE")
      (progn
               (if (setq chk(= pln 2))
       (setq pp1 (nth 19 ed)
             pp9 (cdr pp1);start rotation
             pp11 (cdr pp1);end location
             );end setq
         ;(setq distt1 (fix (/ (distance pp10 pp1) 12.0)))
         );end if 2
               (if (setq chk(= pln 3))
       (setq pp1 (nth 24 ed)
             pp2 (nth 19 ed)
             pp9 (cdr pp2);start rotation
             pp11 (cdr pp1);end location
             pp12 (cdr pp2);end rotation
             );end setq
         ;(setq distt1 (fix (/ ((distance pp10 pp2)+(distance pp2 pp1)) 12.0)))
         );end if 3         
            (if (setq chk(= pln 4))
       (setq pp1 (nth 29 ed)
             pp2 (nth 19 ed)
             pp3 (nth 24 ed)
             pp9 (cdr pp2);start rotation
             pp11 (cdr pp1);end location
             pp12 (cdr pp3);end rotation
             );end setq
         );end if 4
            (if (setq chk(= pln 5))
       (setq pp1 (nth 34 ed)
             pp2 (nth 19 ed)
             pp3 (nth 29 ed)
             pp9 (cdr pp2);start rotation
             pp11 (cdr pp1);end location
             pp12 (cdr pp3);end rotation
             );end setq
         );end if 5
        (if (setq chk(= pln 6))
       (setq pp1 (nth 39 ed)
             pp2 (nth 19 ed)
             pp3 (nth 34 ed)
             pp9 (cdr pp2);start rotation
             pp11 (cdr pp1);end location
             pp12 (cdr pp3);end rotation
             );end setq
         );end if 6
        
        );end progn
   );end if 0
   
       
       
;;;insert start and end placement
    (if (< (distance arr pp10) (distance arr pp11))(setq p9 pp10))
    (if (< (distance arr pp11) (distance arr pp10))(setq p9 pp11))
    (if (> (distance arr pp10) (distance arr pp11))(setq p12 pp10))
    (if (> (distance arr pp11) (distance arr pp10))(setq p12 pp11))

            (setq cpi arr)
                (setq cpix (car cpi))
                (setq cpiy (cadr cpi))
                (setq cp (list cpix cpiy))
           ;(setq lng (length ed))
    ;;;;start
                (setq cdist1 (distance cp pp10))
                (setq cdist2 (distance cp pp9))
                (if (< cdist1 cdist2); begin iloop 3
                    (setq tsp pp10)
                    (setq tsp pp9)); end iloop 3
                (if (< cdist1 cdist2); begin iloop 4
                    (setq tep pp9)
                    (setq tep pp10)); end iloop 4
    ;;;;ends
            (setq cdist13 (distance cp pp11))
                (setq cdist23 (distance cp pp12))
                (if (< cdist13 cdist23); begin iloop 3
                    (setq tsp3 pp11)
                    (setq tsp3 pp12)); end iloop 3
                (if (< cdist13 cdist23); begin iloop 4
                    (setq tep3 pp12)
                    (setq tep3 pp11)); end iloop 4
       
;-------JUSTIFICATION---------------            -------------------------
        (setq tenang (angle tsp tep));start angle
    (setq tenang2 (angle tsp3 tep3));(angle tsp3 tep3));end angle
     (setq tenangro (- tenang (/ pi 2.0)))
    (setq tenangro2 (- tenang2 (/ pi 2.0)))
   (setq tenangconv (/ (fix (* 10.0 (* 180.0 (/ tenang pi)))) 10.0));text info
   (setq tenro (* 180.0 (/ (- tenangro pi) pi)))
       (setq tenro2 (* 180.0 (/ (- tenangro2 pi) pi)))
    
   
    
   ;-----------------INSERT          

    (if (= dt "2")(setq btnl "btenl"
                        btnd "btend"));end if
    (if (= dt "3")(setq btnl "btenl3"
                        btnd "btend3"));end if
    (if (= lyr "S-FND-STEND")(setq btnl "btenl-s"));END IF
    (if (= lyr "S-FND-STEND")(setq btnd "btend-s"));END IF
    (if (= lyr "S-FND-HSTEND")(setq btnl "btenl-s"));END IF
    (if (= lyr "S-FND-HSTEND")(setq btnd "btend-s"));END IF
    (if (= lyr "S-FND-VSTEND")(setq btnl "btenl-s"));END IF
    (if (= lyr "S-FND-VSTEND")(setq btnd "btend-s"));END IF
    
    (command "_.insert" btnl p9 dscal "" tenro)
    (command "_.insert" btnd p12 dscal "" tenro2)
    

    (ssdel en ss)
      )                ;end while
 (command "_.layer" "on" "*" "" "")
 (setvar "clayer" layerset)



 (prin1)
);end defun

[BIGAL]

This is pretty obvious problem, need to make two defuns lines and plines use a cond to check, pity no VL in 2006 ? so much easier for length, startpoint & endpoint, I have somewhere I think at home a do total lengths that has the two or 3 options in it.

 

picked a pline

Command: (setq p10 (cdr (assoc 10 ed)))

(277.136 311.445)

Command: (setq p11 (cdr (assoc 11 ed)))

nil

Edited September 5, 2017 by BIGAL

[kpblc]

(defun get-all-len (/ selset)
 (if (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget "_:L" '((0 . "*LINE"))))))))
        'pickset
        ) ;_ end of =
   (apply '+
          (mapcar (function (lambda (ent) (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent))))
                  (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                  ) ;_ end of mapcar
          ) ;_ end of apply
   ) ;_ end of if
 ) ;_ end of defun

??

[BIGAL]

This was a response for another post just pull out the relevant bits.

 

(defun c:qty ( / lay totline bcount)
(while 
(Setq lay (cdr (assoc 8 (entget (car (entsel "Pick object for layer <Cr> to exit "))))))
(setq totline 0.0
bcount 0 
ss nil)
(princ "\nPick objects")
(setq ss (ssget (list (cons 0 "*LINE,INSERT,ARC,")(cons 8 lay))))
(repeat (setq x (sslength ss))
(setq obj  (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq objname (vla-get-ObjectName obj))
(cond 
((or (= objname "AcDbPolyline" )(= objname "AcDbLine" )) (setq totline (+ (vla-get-length obj) totline)))
((= objname "AcDbBlockReference") (setq bcount (+ 1 bcount))) ; need a split blocks here 
)
)
(alert (strcat "length" (rtos totline 2 0) " or \nCount = " (rtos bcount 2 0)))
)

)

(C:qty)

[j_spawn_h]

I tried things like that. My problem is no matter where I insert that into my lisp it fails. I forgot to tell you I am using 2016 cad.

[devitg]

Please could you upload the dwg where you apply it.

 

Or send it to myusernamehere at gmail

[BIGAL]

j_spawn_h look at this code example

 

(defun plinestuff (ent / )
(setq lay (vla-get-layer ent))
(setq plen (vla-get-length ent))
(setq stpt (vlax-curve-getstartpoint ent))
(setq endpt (vlax-curve-getendpoint ent))
)

(Setq lay (cdr (assoc 8 (entget (car (entsel "Pick object for layer <Cr> to exit "))))))
(princ "\nPick objects")
(setq ss (ssget (list (cons 0 "*LINE")( cons 8 lay))))
(repeat (setq x (sslength ss))
(setq obj  (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq objname (vla-get-ObjectName obj))
(if (or (= objname "AcDbPolyline" )(= objname "AcDbLine" )) (plinestuff obj))
(alert (strcat "length" (rtos plen 2 0)))
)
)

[j_spawn_h]

Devitg,

Here is the drawing.

 

 

Bigal,

So take this defun imbed it in the main lisp? I should do the same for the line info as well? Then bring all this together to make it work? I think I get. I will play with this idea this weekend. Thank you!

test.dwg

[ronjonp]

Here's a quick one to tally lengths by layer:

(defun c:len (/ _getlength l ln out s tmp)
 (defun _getlength (ename / ep)
   (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
     0.0
     (vlax-curve-getdistatparam ename ep)
   )
 )
 (if (setq s (ssget))
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (if (/= 0 (setq l (_getlength e)))
(if (setq tmp (assoc (setq ln (cdr (assoc 8 (entget e)))) out))
  (setq out (subst (cons (car tmp) (+ l (cdr tmp))) tmp out))
  (setq out (cons (cons ln l) out))
)
     )
   )
 )
 (mapcar 'print (vl-sort out '(lambda (a b) (< (car a) (car b)))))
 (princ)
)

[devitg]

Just a question, DATAEXTRACTION : why not?

lines length 2k7-decimal inch .xls

lines length 2k7.xls

j_spawn_h.rar

lines length 2k7-decimal inch+layers .xls

Edited September 6, 2017 by devitg
add files