Author Topic: Polylines direction indication  (Read 4278 times)

0 Members and 1 Guest are viewing this topic.

bprabhakar001

  • Guest
Polylines direction indication
« on: September 03, 2006, 05:34:09 AM »
Dear all,

I need a function to find out the opposite (Reverse) direction polylines, which are overlaping/ partially each other.

Please let me guide to develop this routine with a good logic.

Thanking you,
Prabhakar.B

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Polylines direction indication
« Reply #1 on: September 03, 2006, 05:57:07 AM »
My old programs:  :-)

Reverse "LWPOLYLINE"
Code: [Select]
(defun c:rlw (/ E LW X1 X2 X3 X4 X5 X6)
  (if (and (setq lw (car (entsel "\nSelect lwpolyline")))
           (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
      ) ;_  and
    (progn
      (foreach a1 e
        (cond
          ((= (car a1) 10) (setq x2 (cons a1 x2)))
          ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
          ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
          ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
          ((= (car a1) 210) (setq x6 (cons a1 x6)))
          (t (setq x1 (cons a1 x1)))
        ) ;_  cond
      ) ;_  foreach
      (entmod
        (append
          (reverse x1)
          (append
            (apply
              (function append)
              (apply
                (function mapcar)
                (cons
                  'list
                  (list x2
                        (cdr (reverse (cons (car x3) (reverse x3))))
                        (cdr (reverse (cons (car x4) (reverse x4))))
                        (cdr (reverse (cons (car x5) (reverse x5))))
                  ) ;_  list
                ) ;_  cons
              ) ;_  apply
            ) ;_  apply
            x6
          ) ;_  append
        ) ;_  append
      ) ;_  entmod
      (entupd lw)
    ) ;_  progn
  ) ;_  if
) ;_  defun
checking  "LWPOLYLINE" if pline drawn CW or CCW
Code: [Select]
(defun c:lwcl (/ LW LST MAXP MINP)
  (setq lw (vlax-ename->vla-object (car (entsel))))
  (vla-GetBoundingBox lw 'MinP 'MaxP)
  (setq
    minp (vlax-safearray->list minp)
    MaxP (vlax-safearray->list MaxP)
    lst  (mapcar
           (function
             (lambda (x)
               (vlax-curve-getParamAtPoint
                 lw
                 (vlax-curve-getClosestPointTo lw x)
               ) ;_  vlax-curve-getParamAtPoint
             ) ;_  lambda
           ) ;_  function
           (list minp
                 (list (car minp) (cadr MaxP))
                 MaxP
                 (list (car MaxP) (cadr minp))
           ) ;_  list
         ) ;_  mapcar
  ) ;_  setq
  (if (or
        (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
        (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
        (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
        (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
      ) ;_  or
    t
  ) ;_  if
) ;_  defun

bprabhakar001

  • Guest
Re: Polylines direction indication
« Reply #2 on: September 03, 2006, 07:18:47 AM »
HI,

Thank's but I am unable to understand the results.
Actually my requirment is to find "colliner polyline entity's which are having opposite direction" then mark some circle.
please help me.

Thanking you,
Prabhakar.B
Experience is simply what we call our mistakes

      Good judgement is the result of experience ...

     ... Experience is the result of bad judgement.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Polylines direction indication
« Reply #3 on: September 03, 2006, 07:31:42 AM »
Thank's but I am unable to understand the results.

Code: [Select]
(entmakex
 '((0 . "LWPOLYLINE")
   (100 . "AcDbEntity")
   (100 . "AcDbPolyline")
   (90 . 4)
   (70 . 1)
   (10 0. 0.)
   (10 100. 0.)
   (10 100. 100.)
   (10 0. 100.)
  )
) ;_  entmakex
 ;c:lwcl => NIL
(entmakex
 '((0 . "LWPOLYLINE")
   (100 . "AcDbEntity")
   (100 . "AcDbPolyline")
   (90 . 4)
   (70 . 1)
   (10 0. 0.)
   (10 0. 100.)
   (10 100. 100.)
   (10 100. 0.)
  )
) ;_  entmakex
 ;c:lwcl => T