Jump to content

Distances on a Polyline


Jozi68

Recommended Posts

  • Replies 63
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    29

  • fuqua

    23

  • Jozi68

    6

  • stevesfr

    4

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

Link to comment
Share on other sites

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))))

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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))

Link to comment
Share on other sites

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 ? :)

Link to comment
Share on other sites

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..

Link to comment
Share on other sites

fiber optics, we are connecting houses to the fiberoptic network (tv, phone, internet)

 

Very nice :D

 

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.

Link to comment
Share on other sites

Very nice :D

 

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)

Link to comment
Share on other sites

At this point though, its probably more accurate to select all the lines, then run a LISP to calculate the length of them all... o:)

 

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.

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...