Polyline

Hello!

I try a closed polyline between two other polyline to place. Since I have to keep doing the same, the solution would be through a Lisp a great thing.

Maybe someone could help me since.

Enclosed is a dwg as an example for ease.

Greetings

Martin

Example.dwg

I saw from your previous posts that you have some AutoLISP knowledge, so I will describe the steps I will use if I’ll have to write this routine:

• Select the first polyline using ENTSEL; this will give you the name of the entity and the point picked by user.
  
• Project the selection point to entity - VLAX-CURVE-GETCLOSESTPOINTTO.
  
• Get the distance from first vertex to selection point - VLAX-CURVE-GETDISTATPOINT.
  
• Get the associated list of polyline - ENTGET.
  
• Parse the associated list and compare the distance from first vertex to current one (DXF code 10) with the above got distance to reference point. This way will locate the two vertexes surrounding the selection point.
  
• Repeat the above steps for second polyline.
  
• Use COMMAND or ENTMAKE to create the desired polyline using the two sets of point found above.
  

Hi Mircea!

Unfortunately, I have very little knowledge in Lisp and it can not live to write.

In their description, but I can see that it was the right way.

But thanks for your reply.

greetings

Martin

 
(defun c:MakeP ( / 2points pl1 pl2 vert)
(vl-load-com)      
(defun 2points  (e pt / param)
     (setq param (vlax-curve-getParamAtPoint
                       e
                       (vlax-curve-getClosestPointTo e pt)))
     (list (vlax-curve-getPointAtParam e (fix param))
           (vlax-curve-getPointAtParam e (1+ (fix param)))
           )
     )
     (cond ((and
      (setq pl1 (entsel "\nSelect Polyline:"))
(setq pl2 (entsel "\nSelect Other Polyline:"))
       (apply 'eq (setq vert (mapcar '(lambda (j)
                           (eq (cdr (assoc 0 (entget (car j)))) "LWPOLYLINE"))
                                 (list pl1 pl2))))
       (car vert)
       (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90
                               (length (setq lst  (append
                                                        (2points
                                                              (car pl1)
                                                              (cadr pl1))
                                                        (reverse (2points
                                                              (car pl2)
                                                              (cadr pl2)))))))
                         (cons 70 1))
                    (mapcar (function (lambda (p) (cons 10 p))) lst)))
       )
            )
           )
     (princ)
     )

HTH

My version ...

(defun c:TesT (/ ss1 ss2 p1 p2)
 (vl-load-com)
;;; Tharwat 08. May. 2012 ;;;
 (if (and (setq ss1 (entsel "\n Select First Polyline :"))
          (member (cdr (assoc 0 (entget (car ss1))))
                  '("LWPOLYLINE" "POLYLINE")
          )
          (setq ss2 (entsel "\n Select Second Polyline :"))
          (member (cdr (assoc 0 (entget (car ss2))))
                  '("LWPOLYLINE" "POLYLINE")
          )
     )
   (progn
     (setq
       p1 (fix (vlax-curve-getParamAtPoint
                 (car ss1)
                 (vlax-curve-getclosestpointto (car ss1) (cadr ss1))
               )
          )
     )
     (setq
       p2 (fix (vlax-curve-getParamAtPoint
                 (car ss2)
                 (vlax-curve-getclosestpointto (car ss2) (cadr ss2))
               )
          )
     )
     (entmakex
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
             (cons 90 4)
             (cons 70 1)
             (cons 10 (vlax-curve-getpointatparam (car ss1) p1))
             (cons 10 (vlax-curve-getpointatparam (car ss1) (1+ p1)))
             (cons 10 (vlax-curve-getpointatparam (car ss2) (1+ p2)))
             (cons 10 (vlax-curve-getpointatparam (car ss2) p2))
       )
     )
   )
 )
 (princ)
)

Hello pbe!

Tharwat Hello!

Thank you very much for your help!

You have helped me a lot!

Both Lisp function superbly!

Greetings

Martin

@pBe and Tharwat: Nice codes! You may also add a confirmation prompter that will allow the user to fix the order of drawn polyline (reverse second pair of points) to account for the case when source polylines weren't drawn with the same sense. In that case the result will be a self-crossed shape.

You're right MSasu . and that 's why I tried to avoid that by replacing param3 with param4 .

Anyway , here is the updated version with regards to MSasu for the note .

(defun c:TesT (/ ss1 ss2 p1 param1 param2 p2 param3 param4 pl do)
 (vl-load-com)
;;; Tharwat 08. May. 2012 ;;;
 (defun _Polyline (a b c d)
   (entmakex (list '(0 . "LWPOLYLINE")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPolyline")
                   (cons 90 4)
                   (cons 70 1)
                   (cons 10 a)
                   (cons 10 b)
                   (cons 10 c)
                   (cons 10 d)
             )
   )
 )
 (if (and (setq ss1 (entsel "\n Select First Polyline :"))
          (member (cdr (assoc 0 (entget (car ss1))))
                  '("LWPOLYLINE" "POLYLINE")
          )
          (setq ss2 (entsel "\n Select Second Polyline :"))
          (member (cdr (assoc 0 (entget (car ss2))))
                  '("LWPOLYLINE" "POLYLINE")
          )
     )
   (progn
     (setq
       p1 (fix (vlax-curve-getParamAtPoint
                 (car ss1)
                 (vlax-curve-getclosestpointto (car ss1) (cadr ss1))
               )
          )
     )
     (setq param1 (vlax-curve-getpointatparam (car ss1) p1))
     (setq param2 (vlax-curve-getpointatparam (car ss1) (1+ p1)))
     (setq
       p2 (fix (vlax-curve-getParamAtPoint
                 (car ss2)
                 (vlax-curve-getclosestpointto (car ss2) (cadr ss2))
               )
          )
     )
     (setq param3 (vlax-curve-getpointatparam (car ss2) p2))
     (setq param4 (vlax-curve-getpointatparam (car ss2) (1+ p2)))
     (setq pl (_Polyline param1 param2 param4 param3))

   )
 )
 (initget "Yes Reverse")
 (if (eq (setq do (getkword "\n Accept or Reverse [Yes/Reverse] :"))
         "Reverse"
     )
   (progn
     (command "_.reverse" (car ss1) "")
     (entdel pl)
     (_polyline param1 param2 param3 param4)
   )
   (princ)
 )
 (princ)
)

You may also add a confirmation prompter that will allow the user to fix the order of drawn polyline (reverse second pair of points) to account for the case when source polylines weren't drawn with the same sense. In that case the result will be a self-crossed shape.

Guess you're right , I agree it would be a good addition. But from the looks of it, the other polyline is a result from a call to OFFSET, its probably a guarantee the polyline is in the same direction . good pooint though

Hello pbe!

Thank you very much for your help!

You have helped me a lot!

 

Greetings

Martin

You're welcome. Glad I could help

Here is my 2 cents too

(defun C:win(/ *error* acsp adoc ang curve en1 en2 ent lay locked loop norm obj osm p1-p1 p1-p2 p2-p1 p2-p2
       pline points ps1 ps2 pt pt-o pt1 pt2 ptn sset tmp vi vr vx vz x)
 (defun *error* (msg)
     (vla-endundomark (vla-get-activedocument
             (vlax-get-acad-object))
      )
   (cond ((or (not msg)
       (member msg '("console break" "Function cancelled" "quit / exit abort"))
       )
   )
  ((princ (strcat "\nError: " msg)))
  )
   (setvar "cmdecho" 1)
   (if osm
     (setvar "osmode" osm)
   )
   (if locked
     (foreach x locked (vla-put-lock x :vlax-true))
   )
   (princ)
   )
(setq adoc (vla-get-activedocument
             (vlax-get-acad-object))
     acsp (vla-get-block(vla-get-activelayout adoc)))
 (vla-startundomark adoc )
 (setq osm (getvar "osmode"))

  (setq lay (vla-item (vla-get-layers adoc)"Strichliert"));<-- change layer name here

(if (eq :vlax-true (vla-get-lock lay))
(progn
(setq locked (cons lay locked))
(vla-put-lock x :vlax-true)))
 (setvar "cmdecho" 0)
(setq loop t)
(while loop
(setvar "osmode" 512)
 (setq ent (entsel "\n Select a point on the first polyline (or press Enter to Exit): "))
 (if (and ent
          (equal (assoc 0 (entget (car ent))) '(0 . "LWPOLYLINE"))
     )
    (progn
      (setq en1 (car ent))
   (setq norm (cdr (assoc 210 (entget en1))) ; get the pline normal
    pt1 (vlax-curve-getclosestpointto en1 (trans (cadr ent) 1 0)) ; new point (WCS)
    pt-o (trans pt1 0 norm) ; new point (OCS)
           pt-o (list (car pt-o) (cadr pt-o)) ; 2D point
           vr (vlax-curve-getparamatpoint en1 pt1)
           vi (fix vr)  ; vertex index, one before picked point
           vr (- vr vi) ; vertex remainder, at picked point
     )
   (setq obj       (vlax-ename->vla-object en1))
   (setvar "osmode" 128)
   (setq pt2 (getpoint pt1 "\n Select a point on the opposite polyline: "))
   (setq ps1 (list (- (car pt2) 10.)(- (cadr pt2)10.)(caddr pt2))
  ps2 (list (+(car pt2) 10.)(+ (cadr pt2)10.)(caddr pt2)))

   (setq sset (ssget "F" (list ps1 ps2)(list (cons 0 "LWPOLYLINE"))))
   (setq en2 (ssname sset 0))
  (setq norm (cdr (assoc 210 (entget en2))) ; get the pline normal
    pt2 (vlax-curve-getclosestpointto en2 (trans pt2 1 0)) ; new point (WCS)
    ptn (trans pt2 0 norm) ; new point (OCS)
           ptn (list (car ptn) (cadr ptn)) ; 2D point
           vx (vlax-curve-getparamatpoint en2 pt2)
           vz (fix vx)  ; vertex index, one before picked point
           vx (- vx vz) ; vertex remainder, at picked point
     )
      (setq ang (angle pt1 pt2))
   (setvar "osmode" 0)
      (setq p1-p1 (vlax-curve-getclosestpointto en1 (vlax-curve-getpointatparam en1 vi))
     p1-p2 (vlax-curve-getclosestpointto en1 (vlax-curve-getpointatparam en1 (1+ vi))))
      (if (not (equal (angle p1-p1 p1-p2)(+ ang (/ pi 2)) 0.1))
      (setq tmp (list p1-p1 p1-p2) p1-p1 (cadr tmp) p1-p2 (car tmp)))
      (setq p2-p1 (vlax-curve-getclosestpointto en2 (vlax-curve-getpointatparam en2 vz))
     p2-p2 (vlax-curve-getclosestpointto en2 (vlax-curve-getpointatparam en2 (1+ vz))))
       (if (not (equal (angle p2-p1 p2-p2)(+ ang (/ pi 2)) 0.1))
      (setq tmp (list p2-p1 p2-p2) p2-p1 (cadr tmp) p2-p2 (car tmp)))

    (setq points (list  p1-p1 p1-p2 p2-p2 p2-p1)
      points (mapcar '(lambda(pt)(list (car pt) (cadr pt))) points))
    (setq pline  (vlax-invoke acsp 'addlightweightpolyline (apply 'append points)))
      (vlax-put pline 'closed :vlax-true)
   )
   (setq loop nil)   
   )
 )
 (*error* nil)

 (princ)
 )
(princ "\n\t---\tStart command with: \"WIN\"\t---")
(princ)
(or (vl-load-com)
   (princ))

~'J'~

Hello Fixo!

Unfortunately, an error message:

Command: WIN

Select a point on the first polyline (or press Enter to exit):

Select a point on the opposite polyline: Application Error: ssget W / C requires

two points

Error: Invalid argument type: nil lselsetp

command:

Martin

Tharwat Hello!

 

Thank you very much for your help!

You have helped me a lot!

Both Lisp function superbly!

 

Greetings

Martin

You're welcome .

Please consider my second routine for a better and correct rectangle shaped .

Here is my 2 cents too

~'J'~

Please read Post number #7 for the crossed rectangle shaped

Thanks

Oh well. to make it generic.

Here it is

(defun c:MakeP ( / 2points pl1 pl2 vert p1 p2)
(vl-load-com)      
(defun 2points  (e pt / param)
     (setq param (vlax-curve-getParamAtPoint
                       e
                       (vlax-curve-getClosestPointTo e pt)))
     (list (vlax-curve-getPointAtParam e (fix param))
           (vlax-curve-getPointAtParam e (1+ (fix param)))
           )
     )
     (cond ((and
      (setq pl1 (entsel "\nSelect Polyline:"))
(setq pl2 (entsel "\nSelect Other Polyline:"))
       (apply 'eq (setq vert (mapcar '(lambda (j)
                           (eq (cdr (assoc 0 (entget (car j)))) "LWPOLYLINE"))
                                 (list pl1 pl2))))
       (car vert)
       (setq p1 (2points (car pl1) (cadr pl1)))
    [b][color=blue]   (setq p2 (2points (car pl2) (cadr pl2)))
       (if (inters (Car p1)(car p2)(cadr p1)(cadr p2))
            p2 (setq p2 (reverse p2)))
[/color][/b]        (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90
                               (length (setq lst  [b][color=blue](append p1 p2)[/color][/b])))
                         (cons 70 1))
                    (mapcar (function (lambda (p) (cons 10 p))) lst)))
       )
            )
           )
     (princ)
     )

Sorry it's working good on my end,

I've reloaded this code again

Hello pbe!

cool Lisp

works perfectly

Best regards Martin

@pBe: That’s an even better solution!

Hello Fixo!

Unfortunately, again

Command: (load "P :/ AutoCAD / lisp / lisp-test / win.lsp")

--- Start command with "WIN" ---, Error: Malformed list

in input

Best regards Martin

Hello pbe!

cool Lisp works perfectly

Best regards Martin

Cool beans. Hope you'll learn from it.

Cheers

@pBe: That’s an even better solution!

Thanks MSsasu, Glad you like it.

Cheers

@ Nice idea pBe with inters function .