Can't get the lengths of
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 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 (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
?? 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 layerto exit "))))))(setq totline 0.0bcount 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) 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. Please could you upload the dwg where you apply it.
Or send it to myusernamehere at gmail 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 layerto 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))))) 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 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)) 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
页:
[1]