creating perpendicular line from an existing polyline

[ScoRm]

I have a problem...

I need to make a routine for myself and my co workers.. ok heres the situation

i will be given loads of plan maps from GEMS.And what we need to do is to find the starting point of a polyline

and from there, create a perpendicular line across the next polyline..

its something like this:

 

 

I have attached one sample:

the lines i need is on the layer "perps"

 

is this even possible? They will be dumping us DWG files like this starting tomorrow.

and im talking hundreds of files to be manually look for the starting point to determine where the line starts.

test.dwg

[Emmanuel Delay]

You want that line in layer "perps" and color red, yes?

 

Command PFP.

In a while loop, you select the start point (intersect of the polyline with the white line), then select the other polyline (where the perpendicular line ends)

Repeat.

 

(vl-load-com)

(defun drawLine (p1 p2 lay col)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
                 (cons 8 lay)
                 (cons 62 col)
                 ))
)

;; PFP for polyline find perpendicular
(defun c:pfp ( / pl1 pl2 p1 p2)
  (while T
    ;;(setq pl1 (car (entsel "\nSelect Polyline 1 (for startpoint of red line): ")))
    (setq p1 (getpoint "\nStartpoint of red line"))
    (setq pl2 (car (entsel "\nSelect Polyline 2 (for perpendicular of red line): ")))
    (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
    
    (drawLine p1 p2 "perps" 1)
  )
  (princ)
)

 

If those green polylines were 1 polyline * on the left, and 1 on the right, this routine could be further automated.

Then you would just select polyline 1 (where the red line starts), select polyline 2, then window select the white lines.

the routine finds the intersect points, and automatically draws all the red lines at once.

 

(* this can be done with polyline edit -> join)

Is this something you might want as well?

[ScoRm]

2 hours ago, Emmanuel Delay said:

You want that line in layer "perps" and color red, yes?

 

Command PFP.

In a while loop, you select the start point (intersect of the polyline with the white line), then select the other polyline (where the perpendicular line ends)

Repeat.

 

 

(vl-load-com)

(defun drawLine (p1 p2 lay col)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
                 (cons 8 lay)
                 (cons 62 col)
                 ))
)

;; PFP for polyline find perpendicular
(defun c:pfp ( / pl1 pl2 p1 p2)
  (while T
    ;;(setq pl1 (car (entsel "\nSelect Polyline 1 (for startpoint of red line): ")))
    (setq p1 (getpoint "\nStartpoint of red line"))
    (setq pl2 (car (entsel "\nSelect Polyline 2 (for perpendicular of red line): ")))
    (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
    
    (drawLine p1 p2 "perps" 1)
  )
  (princ)
)

 

 

If those green polylines were 1 polyline * on the left, and 1 on the right, this routine could be further automated.

Then you would just select polyline 1 (where the red line starts), select polyline 2, then window select the white lines.

the routine finds the intersect points, and automatically draws all the red lines at once.

 

(* this can be done with polyline edit -> join)

Is this something you might want as well?

 

 

 

yes sir! this is the one! i love it! i will use this!

if it will automate further i will just join all the yellow polylines

Edited February 17, 2020 by ScoRm

[Emmanuel Delay]

>> if it will automate further i will just join all the yellow polylines

 

Okay, try this.  I prepared a dwg.

Command PFPA

- Select right green polyline

- Select left green polyline

- Window select white lines/polylines (it will ignore objects on other layers), and press enter.

 

command PJ might help you to join the polylines.

First pick 1 section.  Then further select everything except the horizontal section that join the left and right.

Repeat for the other polyline(s)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
;;   acextendnone     Do not extend either object
;;   acextendthisentity     Extend obj1 to meet obj2
;;   acextendotherentity     Extend obj2 to meet obj1
;;   acextendboth     Extend both objects

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Polyline join
;; Based on:
;; https://gist.github.com/samifox/7499899
;; PolylineJoin.lsp [command name: PJ]
;; Based on c:pljoin by beaufordt from AutoCAD Customization Discussion Group
;; Streamlined by Kent Cooper, June 2011
(defun PJ (ss / cmde peac ); = Polyline Join
  (setq
    cmde (getvar 'cmdecho)
    peac (getvar 'peditaccept)
  ); end setq
  (setvar 'cmdecho 0)
  (setvar 'peditaccept 1)
  (if ss
    (if (= (sslength ss) 1)
      (command "_.pedit" ss "_join" "_all" "" ""); then
      (command "_.pedit" "_multiple" ss "" "_join" "0.0" ""); else
    ); end inner if
  ); end outer if
  (setvar 'cmdecho cmde)
  (setvar 'peditaccept peac)
  (entlast)
); end defun;

;; Polyline join.
(defun c:pj ( / ss i)
  (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE") (cons 8 "31") )))
  (PJ ss)
)

;; PFP for polyline find perpendicular Automatic
(defun c:pfpa ( / ss3 pl1 pl2 p1 p2 ins ins1)

  (setq pl1 (car (entsel "\nSelect Polyline 1: ")))
  (setq pl2 (car (entsel "\nSelect Polyline 2: ")))

  (princ "\nSelect white lines: ")
  (setq ss3 (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE") (cons 8 "15") )))
 
  (setq i 0)
  (repeat (sslength ss3)
    (setq ins (LM:intersections (vlax-ename->vla-object (ssname ss3 i)) (vlax-ename->vla-object pl1) acextendnone))
    (if (/= nil ins)
      (if (setq p1 (nth 0 ins)) (progn
        (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
        (drawLine p1 p2 "perps" 1)
      ))
    )
    (setq i (+ i 1))
  )
 
)

;;;;;;;;;;


(vl-load-com)

(defun drawLine (p1 p2 lay col)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
                 (cons 8 lay)
                 (cons 62 col)
                 ))
)

;; PFP for polyline find perpendicular
(defun c:pfp ( / pl1 pl2 p1 p2)
  (while T
    ;;(setq pl1 (car (entsel "\nSelect Polyline 1 (for startpoint of red line): ")))
    (setq p1 (getpoint "\nStartpoint of red line"))
    (setq pl2 (car (entsel "\nSelect Polyline 2 (for perpendicular of red line): ")))
    (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
    
    (drawLine p1 p2 "perps" 1)
  )
  (princ)
)

test2.dwg

[ScoRm]

19 hours ago, Emmanuel Delay said:

>> if it will automate further i will just join all the yellow polylines

 

Okay, try this.  I prepared a dwg.

Command PFPA

- Select right green polyline

- Select left green polyline

- Window select white lines/polylines (it will ignore objects on other layers), and press enter.

 

command PJ might help you to join the polylines.

First pick 1 section.  Then further select everything except the horizontal section that join the left and right.

Repeat for the other polyline(s)

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
;;   acextendnone     Do not extend either object
;;   acextendthisentity     Extend obj1 to meet obj2
;;   acextendotherentity     Extend obj2 to meet obj1
;;   acextendboth     Extend both objects

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Polyline join
;; Based on:
;; https://gist.github.com/samifox/7499899
;; PolylineJoin.lsp [command name: PJ]
;; Based on c:pljoin by beaufordt from AutoCAD Customization Discussion Group
;; Streamlined by Kent Cooper, June 2011
(defun PJ (ss / cmde peac ); = Polyline Join
  (setq
    cmde (getvar 'cmdecho)
    peac (getvar 'peditaccept)
  ); end setq
  (setvar 'cmdecho 0)
  (setvar 'peditaccept 1)
  (if ss
    (if (= (sslength ss) 1)
      (command "_.pedit" ss "_join" "_all" "" ""); then
      (command "_.pedit" "_multiple" ss "" "_join" "0.0" ""); else
    ); end inner if
  ); end outer if
  (setvar 'cmdecho cmde)
  (setvar 'peditaccept peac)
  (entlast)
); end defun;

;; Polyline join.
(defun c:pj ( / ss i)
  (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE") (cons 8 "31") )))
  (PJ ss)
)

;; PFP for polyline find perpendicular Automatic
(defun c:pfpa ( / ss3 pl1 pl2 p1 p2 ins ins1)

  (setq pl1 (car (entsel "\nSelect Polyline 1: ")))
  (setq pl2 (car (entsel "\nSelect Polyline 2: ")))

  (princ "\nSelect white lines: ")
  (setq ss3 (ssget (list (cons 0 "LINE,POLYLINE,LWPOLYLINE") (cons 8 "15") )))
 
  (setq i 0)
  (repeat (sslength ss3)
    (setq ins (LM:intersections (vlax-ename->vla-object (ssname ss3 i)) (vlax-ename->vla-object pl1) acextendnone))
    (if (/= nil ins)
      (if (setq p1 (nth 0 ins)) (progn
        (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
        (drawLine p1 p2 "perps" 1)
      ))
    )
    (setq i (+ i 1))
  )
 
)

;;;;;;;;;;


(vl-load-com)

(defun drawLine (p1 p2 lay col)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
                 (cons 8 lay)
                 (cons 62 col)
                 ))
)

;; PFP for polyline find perpendicular
(defun c:pfp ( / pl1 pl2 p1 p2)
  (while T
    ;;(setq pl1 (car (entsel "\nSelect Polyline 1 (for startpoint of red line): ")))
    (setq p1 (getpoint "\nStartpoint of red line"))
    (setq pl2 (car (entsel "\nSelect Polyline 2 (for perpendicular of red line): ")))
    (setq p2 (vlax-curve-getClosestPointTo pl2 p1))
    
    (drawLine p1 p2 "perps" 1)
  )
  (princ)
)

 

test2.dwg 69.41 kB · 0 downloads

 

 

 

Sir this is way better than the previous one! i love it!. 

its making our productivity faster. thank you so much!