TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ANA 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):
;; 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"))
)
-
Welcome to The Swamp. 8-)
-
Here's one I had lying around for years and decided to upgrade about a month ago. It should also work in BCad.
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~;
; 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)
)
-
Another one to consider: http://www.theswamp.org/index.php?topic=10550.msg133801#msg133801
-
man, daron your's is really nice. i think i will dump mine a do a little borrowing :)
mine was just real simple:
;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)
)
-
Here is the one I posted at the Bricscad forum, (based off what John@ theBricscadforum posted)
Seems to work :-o
(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)
)
-
Oh, and welcome to TheSawmp ANA, 8-)
-
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:
-
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?
-
....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 didnt thrown an exception :-D
-
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:
;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."
-
Daron,
Making the *error* routine local may help too ..
(defun pledit (how wid / osm cmd sset ename etype *error* )
(defun *error* (msg)
;;//..........
-
Thanks Kerry. We'll see how that goes.
-
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:
;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.
;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"
-
That's good.