fuqua Posted June 18, 2009 Posted June 18, 2009 sorry with intersecting i thought u ment crossing a line like a + ( see the pic i posted u will understand what i mean. Quote
stevesfr Posted June 18, 2009 Posted June 18, 2009 Guys, this only uses the IntersectWith method - which doesn't take into account which "side" of the polyline it is on. Could you not attach a dwg file so that I could experiment? Lee, I apologize if there is some misunderstanding, but in any event, my drawing is attched showing what I am having a problem with. Steve INTTXT1.DWG Quote
Lee Mac Posted June 18, 2009 Posted June 18, 2009 Sorry Steve, I was focussing on the request made by Fuqua, try this: (defun c:IntTxt (/ cEnt cObj ss ObjLst iLst ptLst PLst lAng) (if (and (setq cEnt (car (entsel "\nSelect Curve: "))) (member (cdr (assoc 0 (entget cEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))) (progn (setq cObj (vlax-ename->vla-object cEnt) ss (ssget "X" (list (cons 0 "LINE,*POLYLINE") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE"))))))) (ssdel cEnt ss) (setq ObjLst (vl-remove-if-not (function (lambda (x) (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-IntersectWith x cObj acExtendNone)) 1) 0))) (mapcar 'vlax-ename->vla-object (vl-remove-if (function (lambda (x) (eq x cEnt))) (mapcar 'cadr (ssnamex ss)))))) (foreach Obj ObjLst (setq iLst (vlax-safearray->list (vlax-variant-value (vla-IntersectWith Obj cObj acExtendNone)))) (while (not (zerop (length iLst))) (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst) iLst (cdddr iLst))) (setq PLst (cons (cons Obj ptLst) PLst) ptLst nil iLst nil)) (setq PLst (vl-remove-if-not (function (lambda (x) (vl-some (function (lambda (y) (equal y (abs (- (angle '(0 0 0) (vlax-curve-getFirstDeriv (car x) (vlax-curve-getParamatPoint (car x) (cadr x)))) (angle '(0 0 0) (vlax-curve-getFirstDeriv cObj (vlax-curve-getParamatPoint cObj (cadr x)))))) 0.01))) (list (/ pi 2) (/ (* 3 pi) 2.))))) PLst)) (foreach Obj PLst (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv (car Obj) (vlax-curve-getParamatPoint (car Obj) (cadr Obj))))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (Make_Text (cadr Obj) (rtos (vlax-curve-getDistatPoint cObj (cadr Obj)) 2 2) lAng))) (princ "\n<!> No Curve Selected <!>")) (princ)) (defun Make_Text (pt val rot) (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 62 2) (cons 10 pt) (cons 40 (getvar "TEXTSIZE")) (cons 1 val) (cons 50 rot) (cons 7 (getvar "TEXTSTYLE")) '(71 . 0) '(72 . 0) '(73 . 1) (cons 11 pt)))) Quote
stevesfr Posted June 19, 2009 Posted June 19, 2009 Grrrrrrrrrrrrrrrreat, perfecto, thanks Lee Steve Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 Grrrrrrrrrrrrrrrreat, perfecto, thanks LeeSteve No probs Steve - thats what happens when you have two requests in one thread... Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 Lee mac, the file im sending u is 1.6 mb big, which exceeds forum limit, do u got a place/way to send it to you ? Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 Ok, I have taken a look at the file - I can see why your having trouble. The main lines are not one continuous polyline - so the program will only pick up all the polylines intersecting that particular polyline. Also, the program will pick up polylines on other layers, not just those on the red layer. Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 Ok, I have taken a look at the file - I can see why your having trouble. The main lines are not one continuous polyline - so the program will only pick up all the polylines intersecting that particular polyline. Also, the program will pick up polylines on other layers, not just those on the red layer. yeap, its not always possible to have 1 main line, we are using a tree structure with several main lines branching off. could u perhaps change the tool so it auto selects all polylines with in the cluster borders ? (if it is a problem cause of some lines moving out of the cluster then dont worry ill cut them at the border) Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 I have filtered the selection to only select the "branches" by using the layer that they appear to be on. try this: (defun c:IntLen (/ cEnt cObj ss hss ObjLst Len) (vl-load-com) (if (and (setq cEnt (car (entsel "\nSelect Main Polyline: "))) (eq "AcDbPolyline" (vla-get-ObjectName (setq cObj (vlax-ename->vla-object cEnt))))) (progn (setq ss (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 "FttH-01DB5mm-aftakking") (cons 410 (getvar "CTAB"))))) (ssdel cEnt ss) (setq hss (ssadd)) (if (> (sslength ss) 0) (progn (setq ObjLst (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss)))) (setq ObjLst (vl-remove-if-not (function (lambda (x) (vlax-invoke cObj 'IntersectWith x acExtendNone))) ObjLst)) (mapcar (function (lambda (x) (ssadd (vlax-vla-object->ename x) hss))) Objlst) (sssetfirst nil hss) (setq Len (apply '+ (mapcar 'vla-get-Length ObjLst))) (princ (strcat "\n<< Total Length of " (rtos (length ObjLst) 2 0) " Polylines = " (rtos Len 2 2) " >>"))) (princ "\n<< No Intersecting Polylines Found >>"))) (princ "\n<< No Polyline Selected >>")) (princ)) Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 nice that is doing its job nice way of seeing how many connections there are on a mainline are you btw getting a picture what my job is ? Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 nice that is doing its job nice way of seeing how many connections there are on a mainline are you btw getting a picture what my job is ? Well, I don't speak Dutch (think its Dutch anyway), but I reckon drainage EDIT: just saw your border... electronics of some sort.. Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 fiber optics, we are connecting houses to the fiberoptic network (tv, phone, internet) Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 fiber optics, we are connecting houses to the fiberoptic network (tv, phone, internet) Very nice As for the routine - I'm not sure how much better I can make it - I have filtered for the correct layer, but making it allow for crossing borders is a tough one. Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 Very nice As for the routine - I'm not sure how much better I can make it - I have filtered for the correct layer, but making it allow for crossing borders is a tough one. well the thing is we need to calculate the fiber lenght from the dp (distribution point) to each house. keep in mind that each house gets his own dedicated line (so there are no branches "T" like in elektricity) so a separate line from DP to house through the trench. the red line symbolizes the line from dp to house. the blue line from maincentral to each dp. (or (internet) backbone, whatever u want to call it) so in short again, we need to calculate the fiber/tube lenght from maincentral to each dp (individualy) and then again from each dp to each house) Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 At this point though, its probably more accurate to select all the lines, then run a LISP to calculate the length of them all... Quote
fuqua Posted June 19, 2009 Posted June 19, 2009 At this point though, its probably more accurate to select all the lines, then run a LISP to calculate the length of them all... true, but that will only let me know how much trench there needs to be digged and the lenght of the trench is not the same as the length of the fibercable from dp to each house hold, cause each household has its own individual cable from the dp. Quote
Lee Mac Posted June 19, 2009 Posted June 19, 2009 What I mean is select all the branches that you need the length of :wink: Quote
Recommended Posts
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.