Author Topic: Polyline join  (Read 3214 times)

0 Members and 1 Guest are viewing this topic.

ANA

  • Guest
Polyline join
« on: May 15, 2008, 10:23:35 AM »
A polyline-joining routine that works in BricsCad (which doesn't accept an M option for Pedit):

Code: [Select]
;; Join Into polyline - joins a set of contiguous lines, arcs, and/or polylines into a polyline.
;; Selection window can include inappropriate entities, which are ignored.
(defun c:JI ()
(princ "Join lines, arcs, polylines into a single polyline. ")
(sssetfirst nil nil)
(setq ent1 nil)
(while (= ent1 nil) (setq ent1 (entsel "Pick first entity: ")) )
(setq type1 (cdr (assoc 0 ent1) ))
(setq ss1 (ssget '((-4 . "<OR") (0 . "LINE") (0 . "ARC") (0 . "LWPOLYLINE") (-4 . "OR>"))))
(if (= type1 "LWPOLYLINE") (command "Pedit" ent1 "j" ss1 "" ))
(if (/= type1 "LWPOLYLINE") (command "Pedit" ent1 "y" "j" ss1 "" ""))
(sssetfirst nil (ssget "L"))
)
« Last Edit: May 15, 2008, 10:50:36 AM by ANA »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10387
Re: Polyline join
« Reply #1 on: May 15, 2008, 10:29:41 AM »
Welcome to The Swamp.  8-)
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.

daron

  • Guest
Re: Polyline join
« Reply #2 on: May 15, 2008, 02:14:10 PM »
Here's one I had lying around for years and decided to upgrade about a month ago. It should also work in BCad.

Code: [Select]
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~;
; PLedit ;
;---------------------------------------------------------------;
; Main Function ;
; Usage: (plmod (how wid) ("j" nil) or ("w" 4) ;
;---------------------------------------------------------------;
;Author: unknown ;
;Major upgrade: Daron Rogers 2008 ;
;_______________________________________________________________;
(defun mapvars;|Creates paired lst of progvars|;()
     (mapcar '(lambda (x)
   (cons x (getvar x))
      )
     (list "attdia" "cecolor"     "celtype"
   "celweight"   "cmdecho"     "offsetdist"
   "clayer" "dimsah"      "dimzin"
   "expert" "ltscale"     "osmode"
   "plinewid" "snapmode"    "thickness"
   "users1" "users2"      "users3"
   "errno"
  )
     )
)
(defun remapvars;|resets lst from mapvars|;(lst)
     (mapcar '(lambda (x) (setvar (car x) (cdr x))) lst)
)
(defun pledit (how wid / osm cmd sset ename etype *error*)
     (defun *error* (msg)
  (if (not (member msg
   '("console break"
     "Function cancelled"
     "quit / exit abort"
    )
   )
      )
       (progn
    (princ (strcat "\nError: " msg))
       )
  )
  (remapvars map)
  (princ)
     )
     (command "_.undo" "be")
     (setq map (mapvars)
   ename t
     )
     (remapvars '(("cmdecho" . 0) ("osmode" . 0)));fixed
     (if (or (= how "j") (= how "c"))
  (setq sset (vl-catch-all-apply
  '(lambda ()
(ssget (list
    '(-4 . "<OR") '(0 . "*LINE") '(0 . "ARC")
    '(-4 . "OR>") '(-4 . "<NOT") '(0 . "SPLINE")
    '(-4 . "NOT>") '(-4 . "<NOT") '(-4 . "&")
    '(70 . 1) '(-4 . "NOT>"))
)
   )
     )
  )
  (setq sset (vl-catch-all-apply
  '(lambda ()
(ssget (list
    '(0 . "*LINE,ARC")
       )
)
   )
     )
  )
     )
     (if (= sset nil)
  (setq ename nil)
     )
     (while ename
  (cond ((setq ename (ssname sset 0))
(setq etype (cdr (assoc 0 (entget ename))))
(cond ((= how "j")
(cond ((or (= etype "POLYLINE")
   (= etype "LWPOLYLINE")
       )
       (command ".pedit" ename how sset "" "x")
       (setq sset (ssget "p"))
      )
      (t
       (command ".pedit" ename "y" how sset ""
"x")
       (setq sset (ssget "p"))
      )
)
       )
       ((= how "w")
(cond ((or (= etype "POLYLINE")
   (= etype "LWPOLYLINE")
       )
       (command ".pedit" ename how wid "x")
       (ssdel (ssname sset 0) sset)
      )
      (t
       (command ".pedit" ename "y" how wid "x")
       (setq sset (ssget "p"))
      )
)
       )
       (t
(cond
     ((or (= etype "POLYLINE")
  (= etype "LWPOLYLINE")
      )
      (command ".pedit" ename how "")
      (ssdel (ssname sset 0) sset)
     )
     (t
      (command ".pedit" ename "y" how "x")
      (ssdel (ssname sset 0) sset)
     )
)
       )
)
)
(t
(setq ename nil)
)
  )
  (if (= sset nil)
       (setq ename nil)
  )
     )
     (remapvars map)
     (command "_.undo" "e")
) ;_ end of defun

(defun c:plj()
     (prompt "\nSelect the objects to Join: ")
     (pledit "j" nil)
     (princ)
)
(defun c:plc ()
     (prompt "\nSelect the objects to Close: ")
     (pledit "c" nil)
) ;_ end of defun

(defun c:pld ()
     (prompt "\nSelect the objects to Decurve: ")
     (pledit "d" nil)
)

(defun c:plf ()
     (prompt "\nSelect the objects to Fit Curve: ")
     (pledit "f" nil)
)

(defun c:plo ()
     (prompt "\nSelect the objects to Open: ")
     (pledit "o" nil)
)

(defun c:pls ()
     (prompt "\nSelect the objects to Spline Fit: ")
     (pledit "s" nil)
)

(defun c:plw(/ init width)
     (setq init "0.0"
   width (getreal
      (strcat "\nSpecify width of objects: <"
      init
      "> "
      )
)
     )
     (prompt "\nSelect the objects to Widen: ")
     (pledit "w" width)
)
« Last Edit: May 16, 2008, 06:33:29 AM by Daron »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10387
Re: Polyline join
« Reply #3 on: May 15, 2008, 02:23:16 PM »
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.

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Polyline join
« Reply #4 on: May 15, 2008, 09:39:30 PM »
man, daron your's is really nice. i think i will dump mine a do a little borrowing :)

mine was just real simple:

Code: [Select]
;join multiple lines/arcs/polylines
;created: alan thompson
(defun c:mj(/ lines)
(princ "\nSelect lines & arcs to JOIN: ")
(setq lines (ssget '((0 . "*LINE,ARC"))))
(if lines
(progn
(if
(equal (getvar 'peditaccept) 1)
(command "pedit" "m" lines "" "j" "" "")
(command "pedit" "m" lines "" "y" "j" "" "")
);if
);progn
(princ (strcat "\nHey " (getvar "loginname") " it helps if you actually selected something to work with!"))
);if
(princ)
)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 7029
  • AKA Daniel
Re: Polyline join
« Reply #5 on: May 15, 2008, 09:55:09 PM »
Here is the one I posted at the Bricscad forum, (based off what John@ theBricscadforum posted)
Seems to work   :-o

Code: [Select]
(DEFUN C:PJ (/ OBJECT OBJECTNAME OBJTYPE OKOBJECTS OLDCMDECHO SS1)
 (SETQ OKOBJECTS '((0 . "LINE,ARC,POLYLINE,LWPOLYLINE")))
 (PRINC "\nSelect object to join: ")
 (SETQ OLDCMDECHO (GETVAR "CMDECHO")
       SS1 (SSGET OKOBJECTS)
 )
 (SETVAR "CMDECHO" 0)
 (IF (/= SS1 NIL)
  (PROGN
   (SETQ OBJECT (ENTGET (SSNAME SS1 0))
OBJECTNAME (CDR (CAR OBJECT))
OBJTYPE (CDR (ASSOC 0 OBJECT))
   )
   (IF (= (SSLENGTH SS1) 1)
    (SETQ SS1 (SSGET "X" OKOBJECTS))
   )
   (IF (MEMBER OBJTYPE '("LINE" "ARC"))
    (COMMAND "_.pedit" OBJECTNAME "Y" "J" SS1 "" "")
    (COMMAND "_.pedit" OBJECTNAME "J" SS1 "" "")
   )
  )
 )
 (SETVAR "CMDECHO" OLDCMDECHO)
 (PRINC)
)

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 7029
  • AKA Daniel
Re: Polyline join
« Reply #6 on: May 15, 2008, 09:58:55 PM »
Oh, and welcome to TheSawmp ANA, 8-)

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 7029
  • AKA Daniel
Re: Polyline join
« Reply #7 on: May 15, 2008, 10:43:18 PM »
Here's one I had lying around for years and decided to upgrade about a month ago. It should also work in BCad.
...

I think a few small things need to be changed in order for this to run in Bricscad.

(load "dcrutils") MIA
(vl-undobegin) Not Yet Implemented
(varmap '("cmdecho" "osmode") '(0 0)) MIA
(vl-undoend) Not Yet Implemented

And I got an infinite loop if the first item is a polyline

Nice coding though, it would definitely be worth the time make the little changes needed  :kewl:

daron

  • Guest
Re: Polyline join
« Reply #8 on: May 16, 2008, 12:06:45 AM »
Sorry about that Daniel. The (load ...) was meant to be removed. All it does is pull in the variable mapping that I put in with it.

Yes, the vl-undo's could be replaced easily and the (varmap...) I think could be removed and replaced with one of the two variable functions in the beginning. When I realized it was redundant with another I stopped using it and forgot to replace it here. As for the infinite loop if the first item is a polyline, I'll have to look into that as I haven't noticed it. Also, before I read your comments, I noticed that I have a vl-catch-all-apply in there. Is that also going to cause problems for BCad?

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 7029
  • AKA Daniel
Re: Polyline join
« Reply #9 on: May 16, 2008, 12:18:20 AM »
....I noticed that I have a vl-catch-all-apply in there. Is that also going to cause problems for BCad?

I think your good using vl-catch-all-apply, it didn’t thrown an exception  :-D

daron

  • Guest
Re: Polyline join
« Reply #10 on: May 16, 2008, 12:27:12 AM »
Daniel, thanks for the comments. I posted that just as I was leaving work and I didn't browse through it to make sure it was cleaned up for public consumption. I will look into that infinite loop problem tomorrow.
....I noticed that I have a vl-catch-all-apply in there. Is that also going to cause problems for BCad?

I think your good using vl-catch-all-apply, it didn't thrown an exception  :-D
Good deal. Thanks. You using an Asian keyboard. I just noticed your single quote looked like a box with numbers in it?

man, daron your's is really nice. i think i will dump mine a do a little borrowing :)

mine was just real simple:

Code: [Select]
;join multiple lines/arcs/polylines
;created: alan thompson
(defun c:mj(/ lines)
(princ "\nSelect lines & arcs to JOIN: ")
(setq lines (ssget '((0 . "*LINE,ARC"))))
(if lines
(progn
(if
(equal (getvar 'peditaccept) 1)
(command "pedit" "m" lines "" "j" "" "")
(command "pedit" "m" lines "" "y" "j" "" "")
);if
);progn
(princ (strcat "\nHey " (getvar "loginname") " it helps if you actually selected something to work with!"))
);if
(princ)
)

Alan, I truly appreciate the praise. The original one was real simple, though the concept was intact with all the options individualized. The problem I had with it was that it had code functions in multiple places and I wanted it as an all-in-one function. I know that comes with its own problems as Daniel pointed out. I also wanted a bit more functionality than it originally had, so I added those options, like not selected a closed polyline if my intent is to join or close a polyline and to also not select objects that couldn't be processed. BTW, I love the prompt in yours. That's funny. Now, you need to add the AutocadSpeak program to go with it. I'd love to hear it pronounce my work computers username; "Hey drogers pick something that I can work with you idiot."

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Polyline join
« Reply #11 on: May 16, 2008, 01:34:28 AM »
Daron,
Making the *error* routine local may help too ..

(defun pledit (how wid / osm cmd sset ename etype *error* )
     (defun *error* (msg)
          ;;//..........
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

daron

  • Guest
Re: Polyline join
« Reply #12 on: May 16, 2008, 06:34:08 AM »
Thanks Kerry. We'll see how that goes.

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Polyline join
« Reply #13 on: May 16, 2008, 12:10:45 PM »
Daniel, thanks for the comments. I posted that just as I was leaving work and I didn't browse through it to make sure it was cleaned up for public consumption. I will look into that infinite loop problem tomorrow.
....I noticed that I have a vl-catch-all-apply in there. Is that also going to cause problems for BCad?

I think your good using vl-catch-all-apply, it didn't thrown an exception  :-D
Good deal. Thanks. You using an Asian keyboard. I just noticed your single quote looked like a box with numbers in it?

man, daron your's is really nice. i think i will dump mine a do a little borrowing :)

mine was just real simple:

Code: [Select]
;join multiple lines/arcs/polylines
;created: alan thompson
(defun c:mj(/ lines)
(princ "\nSelect lines & arcs to JOIN: ")
(setq lines (ssget '((0 . "*LINE,ARC"))))
(if lines
(progn
(if
(equal (getvar 'peditaccept) 1)
(command "pedit" "m" lines "" "j" "" "")
(command "pedit" "m" lines "" "y" "j" "" "")
);if
);progn
(princ (strcat "\nHey " (getvar "loginname") " it helps if you actually selected something to work with!"))
);if
(princ)
)

Alan, I truly appreciate the praise. The original one was real simple, though the concept was intact with all the options individualized. The problem I had with it was that it had code functions in multiple places and I wanted it as an all-in-one function. I know that comes with its own problems as Daniel pointed out. I also wanted a bit more functionality than it originally had, so I added those options, like not selected a closed polyline if my intent is to join or close a polyline and to also not select objects that couldn't be processed. BTW, I love the prompt in yours. That's funny. Now, you need to add the AutocadSpeak program to go with it. I'd love to hear it pronounce my work computers username; "Hey drogers pick something that I can work with you idiot."

lol, awesome.
Code: [Select]
;join multiple lines/arcs
;created: alan thompson
(defun c:mj(/ lines)
(princ "\nSelect lines & arcs to JOIN: ")
(setq lines (ssget '((0 . "*LINE,ARC"))))
(if lines
(progn
(if
(equal (getvar 'peditaccept) 1)
(command "pedit" "m" lines "" "j" "" "")
(command "pedit" "m" lines "" "y" "j" "" "")
);if
);progn
(progn
(princ (strcat "\nHey " (getvar "loginname") " it helps if you actually select something to work with!"))
(sayit (strcat "HA HA HA HA HA HA HA HA HA HA HA HA HA HA HA" (getvar "loginname") "sucks"))
);progn
);if
(princ)
)

(defun SayIt (Phrase$ / Sapi)
  (setq Sapi (vlax-create-object "Sapi.SpVoice"))
  (vlax-invoke Sapi "Speak" Phrase$ 0)
  (vlax-release-object Sapi)

  (princ)
);defun SayIt

athompson sounds like "ahh thompson"
« Last Edit: May 16, 2008, 12:14:22 PM by alanjt »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

daron

  • Guest
Re: Polyline join
« Reply #14 on: May 16, 2008, 03:13:51 PM »
That's good.