Author Topic: Draw polyline  (Read 2647 times)

0 Members and 1 Guest are viewing this topic.

mcn

  • Guest
Draw polyline
« on: September 15, 2008, 07:21:53 AM »
hello to all,

I'm new to this kind of work and i want to know how can I draw a polyline in the middle of the 2 lines yellow? as it is seen in the example.

I want to draw the line at a specific length=60m, and at the end to put an block or something like it is in the example with lime line. The orange line must follow the 2 yellow lines and when it is an intersection to put the lime block. Also when it change a direction must insert the same block.

best regards,
marius

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Draw polyline
« Reply #1 on: September 15, 2008, 08:51:36 AM »
This appears to be a rather complex endeavor for the following reasons.
The DRUM layer contains LINES & ARCs.
There are cases where there are lines on top of lines.
The lines are not parallel.
The lines sometimes overlap end points.
There are cases endpoints on one side of the waterway align with mid points of lines on the other side.

The only solution I could come up with is for the user to select the lines leading up to the intersection & just beyond.
This would help the routine locate the intersection & the 60m point along the lines.  But still not a trivial routine to create.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

mcn

  • Guest
Re: Draw polyline
« Reply #2 on: September 15, 2008, 11:19:58 AM »
Another way to draw the polyline at least in the middle of the 2 lines, if it's possible, without the 60 m length.

thanks

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Draw polyline
« Reply #3 on: September 15, 2008, 12:55:21 PM »
This is a quick attempt to automate the process.

Pick the first two points at the intersection. First one at a corner & the second one diagonally across the intersection.
Then pick two more points near where the 60 m point will be. Again one on each side.
Code: [Select]
(defun C:MakeCL (/ usercmd p0 p1 p2 p3 clayer lyr clr)
  (setq usercmd (getvar "CMDECHO"))
  (setq clayer (getvar "CLAYER"))
 
  (setvar "CMDECHO" 0)

  ;;  Make Layer
  (setq lyr "retea_canal"
        Clr "40")
  (if (tblsearch "LAYER" lyr)
    (command "._Layer" "_Thaw" lyr "_On" lyr "_UnLock" lyr "_Set" lyr "")
    (command "._Layer" "_Make" lyr "_Color" (if (= Clr "") "_White" Clr) lyr "")
  )

  (while
    (and
    (setq p1 (getpoint "\nPick 2 points to center START between."))
    (setq p2 (getpoint p1 "\nPick second point for START."))
    (setq p1 (osnap p1 "_end,_nea")
          p2 (osnap p2 "_end,_nea"))
    (setq p0 (polar p1 (angle p1 p2) (/(distance p1 p2)2.0)))

    (setq p1 (getpoint p0 "\nPick 2 points to center END between."))
    (setq p2 (getpoint p1 "\nPick second point for END."))
    (setq p1 (osnap p1 "_end,_nea")
          p2 (osnap p2 "_end,_nea"))
    (setq p3 (polar p1 (angle p1 p2) (/(distance p1 p2)2.0)))
    (vl-cmdf "_.pline" "_non" p0 "_non" (polar p0 (angle p0 p3) 60.0) "")
    )
  ) ; end  while
  (setvar "CMDECHO" usercmd)
  (setvar "CLAYER" clayer)
 
  (princ)
) ; end defun
(prompt "\nCreate Center Line from pick points.  Enter MakeCL to run.")
(Princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

mcn

  • Guest
Re: Draw polyline
« Reply #4 on: September 16, 2008, 02:32:21 AM »
it is working fine, thanks, a little adjustment if is possible to add manual the length(user to be able to introduce it)

thanks

best regards,
Marius

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Draw polyline
« Reply #5 on: September 16, 2008, 07:30:46 AM »
Try this, but you will need to remove or comment out one of the new code sections depending on how you want to be prompted.
The first occurrence will ask each time you start the lisp.
The second occurrence will ask over and over as you make more plines.
Code: [Select]
(defun C:MakeCL (/ usercmd p0 p1 p2 p3 clayer lyr clr tmp)
  (setq usercmd (getvar "CMDECHO"))
  (setq clayer (getvar "CLAYER"))
 
  (setvar "CMDECHO" 0)
  (or ClLength (setq ClLength 60.0)) ; Default Length
 
  ;;  Make Layer
  (setq lyr "retea_canal"
        Clr "40")
  (if (tblsearch "LAYER" lyr)
    (command "._Layer" "_Thaw" lyr "_On" lyr "_UnLock" lyr "_Set" lyr "")
    (command "._Layer" "_Make" lyr "_Color" (if (= Clr "") "_White" Clr) lyr "")
  )
  ;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  ;;  This will ask once each time you run the routine
  (if (setq tmp (getdist (strcat "\nEnter new Center Line Length. <"
                                 (rtos ClLength 2 2)"> ")))
    (setq ClLength tmp)
  )
  ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  (while
    (and
    (setq p1 (getpoint "\nPick 2 points to center START between."))
    (setq p2 (getpoint p1 "\nPick second point for START."))
    (setq p1 (osnap p1 "_end,_nea")
          p2 (osnap p2 "_end,_nea"))
    (setq p0 (polar p1 (angle p1 p2) (/(distance p1 p2)2.0)))

    (setq p1 (getpoint p0 "\nPick 2 points to center END between."))
    (setq p2 (getpoint p1 "\nPick second point for END."))
    (setq p1 (osnap p1 "_end,_nea")
          p2 (osnap p2 "_end,_nea"))
    (setq p3 (polar p1 (angle p1 p2) (/(distance p1 p2)2.0)))
    ;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    ;;  This will ask each time you create a Center Line
    (if (setq tmp (getdist (strcat "\nEnter new Center Line Length. <"
                                   (rtos ClLength 2 2)"> ")))
      (setq ClLength tmp)
      t
    )
    ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    (vl-cmdf "_.pline" "_non" p0 "_non" (polar p0 (angle p0 p3) ClLength) "")
    )
  ) ; end  while
  (setvar "CMDECHO" usercmd)
  (setvar "CLAYER" clayer)
 
  (princ)
) ; end defun
(prompt "\nCreate Center Line from pick points.  Enter MakeCL to run.")
(Princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.