ziele_o2k Posted December 7, 2016 Posted December 7, 2016 I wrote some lisp for shortening both ends of pline/line. This routine is based on "_.lengthen" command, but there is one problem, using this command I can't shorten plines/lines which ends are not on screen. Any suggestions how to achieve my goal without using (command)? Quote
Grrr Posted December 7, 2016 Posted December 7, 2016 (edited) Hi, You mean like this, but reverse? Have you looked up at the vlax-curve-**** functions? EDIT: BTW do you want to shorten at both ends or only at the picked one? EDIT2: Anyway, consider this: [color=#8b4513]; Trim Curve[/color] [b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / n pick e p spt ept [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]initget [b][color=BLUE]([/color][/b]+ 2 4[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq n [b][color=GREEN]([/color][/b]getreal [color=#2f4f4f]"\nSpecify trim value <exit>: "[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]progn [b][color=MAROON]([/color][/b]setvar 'errno 0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]/= 52 [b][color=BLUE]([/color][/b]getvar 'errno[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq pick [b][color=BLUE]([/color][/b]entsel [color=#2f4f4f]"\nSpecify side on curve to shorten <exit>: "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b] [b][color=RED]([/color][/b]= 7 [b][color=PURPLE]([/color][/b]getvar 'errno[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nMissed, try again."[/color][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setvar 'errno 0[b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b] [b][color=RED]([/color][/b]and [b][color=PURPLE]([/color][/b]= 'ENAME [b][color=TEAL]([/color][/b]type [b][color=OLIVE]([/color][/b]car pick[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]vl-catch-all-error-p [b][color=TEAL]([/color][/b]vl-catch-all-apply 'vlax-curve-getEndParam [b][color=OLIVE]([/color][/b]list [b][color=GRAY]([/color][/b]car pick[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nYou must select a curve object."[/color][b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b] [b][color=RED]([/color][/b]and pick [b][color=PURPLE]([/color][/b]< [b][color=TEAL]([/color][/b]vlax-curve-getDistAtParam [b][color=OLIVE]([/color][/b]car pick[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]vlax-curve-getEndParam [b][color=GRAY]([/color][/b]car pick[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] n[b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nThis curve is shorter than the specified trim value."[/color][b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b] [b][color=RED]([/color][/b]and pick [b][color=PURPLE]([/color][/b]setq e [b][color=TEAL]([/color][/b]car pick[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq p [b][color=TEAL]([/color][/b]cadr pick[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cond [b][color=PURPLE]([/color][/b] [b][color=TEAL]([/color][/b]vlax-curve-isClosed e[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]princ [color=#2f4f4f]"\nThis curve is closed, cannot be trimmed."[/color][b][color=TEAL])[/color][/b] [b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]T [b][color=TEAL]([/color][/b]if [color=#8b4513]; trim the picked side, to modify it to trim both sides: just remove/comment this [b][color=OLIVE]([/color][/b]if[b][color=OLIVE])[/color][/b] function, and the [color=#2f4f4f]"T"[/color] symbol from the [b][color=OLIVE]([/color][/b]cond[b][color=OLIVE])[/color][/b][/color] [b][color=OLIVE]([/color][/b]>= [b][color=GRAY]([/color][/b]distance p [b][color=AQUA]([/color][/b]setq spt [b][color=LIME]([/color][/b]vlax-curve-getPointAtParam e [b][color=SILVER]([/color][/b]vlax-curve-getStartParam e[b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]distance p [b][color=AQUA]([/color][/b]setq ept [b][color=LIME]([/color][/b]vlax-curve-getPointAtParam e [b][color=SILVER]([/color][/b]vlax-curve-getEndParam e[b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]command [color=#2f4f4f]"_.BREAK"[/color] [b][color=GRAY]([/color][/b]nentselp ept[b][color=GRAY])[/color][/b] [color=#2f4f4f]"_non"[/color] [b][color=GRAY]([/color][/b]vlax-curve-getPointAtDist e [b][color=AQUA]([/color][/b]- [b][color=LIME]([/color][/b]vlax-curve-getDistAtPoint e ept[b][color=LIME])[/color][/b] n[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]command [color=#2f4f4f]"_.BREAK"[/color] [b][color=GRAY]([/color][/b]nentselp spt[b][color=GRAY])[/color][/b] [color=#2f4f4f]"_non"[/color] [b][color=GRAY]([/color][/b]vlax-curve-getPointAtDist e [b][color=AQUA]([/color][/b]+ [b][color=LIME]([/color][/b]vlax-curve-getDistAtPoint e spt[b][color=LIME])[/color][/b] n[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=OLIVE])[/color][/b] [b][color=TEAL])[/color][/b][color=#8b4513]; if[/color] [b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b][color=#8b4513]; cond[/color] [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]T nil[b][color=BLUE])[/color][/b] [b][color=GREEN])[/color][/b][color=#8b4513]; cond[/color] [b][color=MAROON])[/color][/b][color=#8b4513]; while[/color] [b][color=NAVY])[/color][/b][color=#8b4513]; progn[/color] [b][color=FUCHSIA])[/color][/b][color=#8b4513]; if[/color] [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b] [b][color=BLACK])[/color][/b][color=#8b4513];| defun |; [b][color=BLACK]([/color][/b]vl-load-com[b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b][/color] EDIT3: I guess that you look for something like this: [color=#8b4513]; Trim Curves - Both ends[/color] [b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / n Lst2 r [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]not [b][color=MAROON]([/color][/b]initget [b][color=GREEN]([/color][/b]+ 2 4[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq n [b][color=MAROON]([/color][/b]getreal [color=#2f4f4f]"\nSpecify trim value <exit>: "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]and n [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nSelect curves to trim: "[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vl-some 'ssget [b][color=GREEN]([/color][/b]list [color=#2f4f4f]"_I"[/color] [color=#2f4f4f]"_:L"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]progn [b][color=MAROON]([/color][/b] [b][color=GREEN]([/color][/b]lambda [b][color=BLUE]([/color][/b] SS / Lst [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]if SS [b][color=RED]([/color][/b]progn [b][color=PURPLE]([/color][/b]vlax-map-collection SS [b][color=TEAL]([/color][/b]function [b][color=OLIVE]([/color][/b]lambda [b][color=GRAY]([/color][/b]o[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]setq Lst [b][color=AQUA]([/color][/b]cons [b][color=LIME]([/color][/b]vlax-vla-object->ename o[b][color=LIME])[/color][/b] Lst[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]mapcar [b][color=TEAL]([/color][/b]function [b][color=OLIVE]([/color][/b]lambda [b][color=GRAY]([/color][/b]e / spt ept[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]if [b][color=AQUA]([/color][/b]and [b][color=LIME]([/color][/b]not [b][color=SILVER]([/color][/b]or [b][color=YELLOW]([/color][/b]vl-catch-all-error-p [b][color=WHITE]([/color][/b]vl-catch-all-apply 'vlax-curve-getEndParam [b][color=BLACK]([/color][/b]list e[b][color=BLACK])[/color][/b][b][color=WHITE])[/color][/b][b][color=YELLOW])[/color][/b] [b][color=YELLOW]([/color][/b]vlax-curve-isClosed e[b][color=YELLOW])[/color][/b] [b][color=YELLOW]([/color][/b]< [b][color=WHITE]([/color][/b]vlax-curve-getDistAtParam e [b][color=BLACK]([/color][/b]vlax-curve-getEndParam e[b][color=BLACK])[/color][/b][b][color=WHITE])[/color][/b] n[b][color=YELLOW])[/color][/b] [b][color=SILVER])[/color][/b] [b][color=LIME])[/color][/b] [b][color=LIME]([/color][/b]setq spt [b][color=SILVER]([/color][/b]vlax-curve-getPointAtParam e [b][color=YELLOW]([/color][/b]vlax-curve-getStartParam e[b][color=YELLOW])[/color][/b][b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b] [b][color=LIME]([/color][/b]setq ept [b][color=SILVER]([/color][/b]vlax-curve-getPointAtParam e [b][color=YELLOW]([/color][/b]vlax-curve-getEndParam e[b][color=YELLOW])[/color][/b][b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b] [b][color=AQUA])[/color][/b] [b][color=AQUA]([/color][/b]setq Lst2 [b][color=LIME]([/color][/b]cons [b][color=SILVER]([/color][/b]list e spt ept[b][color=SILVER])[/color][/b] Lst2[b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b] [b][color=GRAY])[/color][/b] [b][color=OLIVE])[/color][/b] [b][color=TEAL])[/color][/b] Lst [b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]vla-Delete SS[b][color=BLUE])[/color][/b] [b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]vla-get-ActiveSelectionSet [b][color=BLUE]([/color][/b]vla-get-ActiveDocument [b][color=RED]([/color][/b]vlax-get-acad-object[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-EndUndoMark [b][color=GREEN]([/color][/b]vla-get-ActiveDocument [b][color=BLUE]([/color][/b]vlax-get-acad-object[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-StartUndoMark [b][color=GREEN]([/color][/b]vla-get-ActiveDocument [b][color=BLUE]([/color][/b]vlax-get-acad-object[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-ZoomExtents [b][color=GREEN]([/color][/b]vlax-get-acad-object[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]foreach x Lst2 [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]vl-catch-all-error-p [b][color=PURPLE]([/color][/b]setq r [b][color=TEAL]([/color][/b]vl-catch-all-apply 'vlax-curve-getDistAtPoint [b][color=OLIVE]([/color][/b]list [b][color=GRAY]([/color][/b]car x[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]caddr x[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] r [b][color=BLUE]([/color][/b]command [color=#2f4f4f]"_.BREAK"[/color] [b][color=RED]([/color][/b]nentselp [b][color=PURPLE]([/color][/b]caddr x[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [color=#2f4f4f]"_non"[/color] [b][color=RED]([/color][/b]vlax-curve-getPointAtDist [b][color=PURPLE]([/color][/b]car x[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]- r n[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]vl-catch-all-error-p [b][color=PURPLE]([/color][/b]setq r [b][color=TEAL]([/color][/b]vl-catch-all-apply 'vlax-curve-getDistAtPoint [b][color=OLIVE]([/color][/b]list [b][color=GRAY]([/color][/b]car x[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]cadr x[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] r [b][color=BLUE]([/color][/b]command [color=#2f4f4f]"_.BREAK"[/color] [b][color=RED]([/color][/b]nentselp [b][color=PURPLE]([/color][/b]cadr x[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [color=#2f4f4f]"_non"[/color] [b][color=RED]([/color][/b]vlax-curve-getPointAtDist [b][color=PURPLE]([/color][/b]car x[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]+ r n[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b] [b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-ZoomPrevious [b][color=GREEN]([/color][/b]vlax-get-acad-object[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-EndUndoMark [b][color=GREEN]([/color][/b]vla-get-ActiveDocument [b][color=BLUE]([/color][/b]vlax-get-acad-object[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b] [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b] [b][color=BLACK])[/color][/b][color=#8b4513];| defun |; [b][color=BLACK]([/color][/b]vl-load-com[b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b][/color] It has issue with some curves, IDK why.. although the "screen problem" is not a problem because of the Zoom methods. Edited December 7, 2016 by Grrr Quote
marko_ribar Posted December 7, 2016 Posted December 7, 2016 There is more info ab Lee's Double Extend... Look here - swamp members only... https://www.theswamp.org/index.php?topic=49394.0 M.R. Quote
Grrr Posted December 7, 2016 Posted December 7, 2016 There is more info ab Lee's Double Extend...Look here - swamp members only... https://www.theswamp.org/index.php?topic=49394.0 M.R. Oh nice, a shrink option! BTW I forgot to include that length check if the trim value is bigger than the actual's curve length. IMO the extend would more useful if it was prompting to pick a side on curve, one by one (like the reverse of the first gif I uploaded here). Quote
marko_ribar Posted December 8, 2016 Posted December 8, 2016 (edited) Oh nice, a shrink option!BTW I forgot to include that length check if the trim value is bigger than the actual's curve length. IMO the extend would more useful if it was prompting to pick a side on curve, one by one (like the reverse of the first gif I uploaded here). ; Trim Curve (defun C:trimcurve ( / n pick e p spt ept ) (vl-load-com) (or *n* (setq *n* 1.0)) (initget (+ 2 4)) (setq n (getdist (strcat "\nPick or specify trim value <" (rtos *n* 2 20) "> : "))) (if (null n) (setq n *n*) (setq *n* n) ) (setvar 'errno 0) (while (/= 52 (getvar 'errno)) (setq pick (entsel "\nSpecify side on curve to shorten <exit> : ")) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ( (and (= 'ENAME (type (car pick))) (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list (car pick)))) ) (princ "\nYou must select a curve object.") ) ( (and pick (< (vlax-curve-getDistAtParam (car pick) (vlax-curve-getEndParam (car pick))) n) ) (princ "\nThis curve is shorter than the specified trim value.") ) ( (and pick (setq e (car pick)) (setq p (vlax-curve-getclosestpointto e (trans (cadr pick) 1 0))) ) (cond ( (vlax-curve-isClosed e) (princ "\nThis curve is closed, cannot be trimmed.") ) (T (if (>= (distance p (setq spt (vlax-curve-getStartPoint e))) (distance p (setq ept (vlax-curve-getEndPoint e))) ) (command "_.BREAK" (nentselp (trans ept 0 1)) "_non" (trans (vlax-curve-getPointAtDist e (- (vlax-curve-getDistAtPoint e ept) n)) 0 1) ) (command "_.BREAK" (nentselp (trans spt 0 1)) "_non" (trans (vlax-curve-getPointAtDist e (+ (vlax-curve-getDistAtPoint e spt) n)) 0 1) ) ); if ) ); cond ) ); cond ); while (princ) ) ; Extend Curve (defun C:extendcurve ( / n pick e p spt ept ) (vl-load-com) (or *n* (setq *n* 1.0)) (initget (+ 2 4)) (setq n (getdist (strcat "\nPick or specify extend value <" (rtos *n* 2 20) "> : "))) (if (null n) (setq n *n*) (setq *n* n) ) (setvar 'errno 0) (while (/= 52 (getvar 'errno)) (setq pick (entsel "\nSpecify side on curve to lengthen <exit> : ")) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ( (and (= 'ENAME (type (car pick))) (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list (car pick)))) ) (princ "\nYou must select a curve object.") ) ( (and pick (setq e (car pick)) (setq p (vlax-curve-getclosestpointto e (trans (cadr pick) 1 0))) ) (cond ( (vlax-curve-isClosed e) (princ "\nThis curve is closed, cannot be extended.") ) (T (if (>= (distance p (setq spt (vlax-curve-getStartPoint e))) (distance p (setq ept (vlax-curve-getEndPoint e))) ) (progn (command "_.LENGTHEN" "_DE" n "_non" (trans ept 0 1) "") (setvar 'errno 0) ) (progn (command "_.LENGTHEN" "_DE" n "_non" (trans spt 0 1) "") (setvar 'errno 0) ) ); if ) ); cond ) ); cond ); while (princ) ) HTH., M.R. Edited December 9, 2016 by marko_ribar Quote
Grrr Posted December 8, 2016 Posted December 8, 2016 ; Extend Curve (defun C:extendcurve ( / n pick e p spt ept ) (vl-load-com) (if (and (not (initget (+ 2 4))) (setq n (getdist "\nSpecify extend value <exit> : ")) ) (progn (setvar 'errno 0) (while (/= 52 (getvar 'errno)) (setq pick (entsel "\nSpecify side on curve to lengthen <exit> : ")) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ( (and (= 'ENAME (type (car pick))) (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list (car pick)))) ) (princ "\nYou must select a curve object.") ) ( (and pick (setq e (car pick)) (setq p (vlax-curve-getclosestpointto e (trans (cadr pick) 1 0))) ) (cond ( (vlax-curve-isClosed e) (princ "\nThis curve is closed, cannot be extended.") ) (T (if (>= (distance p (setq spt (vlax-curve-getPointAtParam e (vlax-curve-getStartParam e)))) (distance p (setq ept (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e)))) ) (progn (command "_.LENGTHEN" "_DE" n "_non" ept "") (setvar 'errno 0) ) (progn (command "_.LENGTHEN" "_DE" n "_non" spt "") (setvar 'errno 0) ) ); if ) ); cond ) ); cond ); while ); progn ); if (princ) );| defun |; HTH., M.R. Sweet! IMO this is a handy tool to be added to your PLINETOOLS. Quote
marko_ribar Posted December 9, 2016 Posted December 9, 2016 (edited) Revision of your second code... Although using (vl-some) in unusual way is inventive with 'ssget, I think that here is unnecessary and over programming situation... As you can see I've changed both my codes from previous post and now all 4 are compatible in a way that previous input can be used sequentially - only thing that user should look for is to nil global *n* variable after task(s) is(are) completed... ; Trim Curves - Both ends (defun C:trimcurves ( / n Lst2 r ) (vl-load-com) (or *n* (setq *n* 1.0)) (initget (+ 2 4)) (setq n (getdist (strcat "\nPick or specify trim value <" (rtos *n* 2 20) "> : "))) (if (null n) (setq n *n*) (setq *n* n) ) (while (and (princ "\nSelect curves to trim <exit> : ") (ssget "_:L-I" '((0 . "*POLYLINE,SPLINE,LINE,HELIX,ARC,ELLIPSE"))) ) (progn ( (lambda ( SS / Lst ) (if SS (progn (vlax-map-collection SS (function (lambda ( o ) (setq Lst (cons (vlax-vla-object->ename o) Lst))))) (mapcar (function (lambda ( e / spt ept ) (if (and (not (or (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list e))) (vlax-curve-isClosed e) (< (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) n) ) ) (setq spt (vlax-curve-getStartPoint e)) (setq ept (vlax-curve-getEndPoint e)) ) (setq Lst2 (cons (list e spt ept) Lst2)) ) ) ) Lst ) ) ) (vla-Delete SS) ) (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))) ) (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-ZoomExtents (vlax-get-acad-object)) (foreach x Lst2 (and (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list (car x) (caddr x)))))) r (command "_.BREAK" (nentselp (caddr x)) "_non" (trans (vlax-curve-getPointAtDist (car x) (- r n)) 0 1) ) ) (and (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list (car x) (cadr x)))))) r (command "_.BREAK" (nentselp (cadr x)) "_non" (trans (vlax-curve-getPointAtDist (car x) (+ r n)) 0 1) ) ) ) (vla-ZoomPrevious (vlax-get-acad-object)) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ) ) (princ) ) ; Extend Curves - Both ends (defun C:extendcurves ( / n Lst2 r ) (vl-load-com) (or *n* (setq *n* 1.0)) (initget (+ 2 4)) (setq n (getdist (strcat "\nPick or specify extend value <" (rtos *n* 2 20) "> : "))) (if (null n) (setq n *n*) (setq *n* n) ) (while (and (princ "\nSelect curves to extend <exit> : ") (ssget "_:L-I" '((0 . "*POLYLINE,SPLINE,LINE,HELIX,ARC,ELLIPSE"))) ) (progn ( (lambda ( SS / Lst ) (if SS (progn (vlax-map-collection SS (function (lambda ( o ) (setq Lst (cons (vlax-vla-object->ename o) Lst))))) (mapcar (function (lambda ( e / spt ept ) (if (and (not (or (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list e))) (vlax-curve-isClosed e) ) ) (setq spt (vlax-curve-getStartPoint e)) (setq ept (vlax-curve-getEndPoint e)) ) (setq Lst2 (cons (list e spt ept) Lst2)) ) ) ) Lst ) ) ) (vla-Delete SS) ) (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))) ) (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-ZoomExtents (vlax-get-acad-object)) (foreach x Lst2 (and (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list (car x) (caddr x)))))) r (command "_.LENGTHEN" "_DE" n "_non" (trans (caddr x) 0 1) "") ) (and (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vlax-curve-getDistAtPoint (list (car x) (cadr x)))))) r (command "_.LENGTHEN" "_DE" n "_non" (trans (cadr x) 0 1) "") ) ) (vla-ZoomPrevious (vlax-get-acad-object)) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ) ) (princ) ) Regards, M.R. P.S. I don't know what did you wanted to say regarding PLINETOOLS - they are in my opinion correctly filled with all lisps it should have... Those lisps posted here are independent and may or may not be applied on POLYLINE entity(ies), so PLINETOOLS are separate story... Edited December 10, 2016 by marko_ribar Quote
Grrr Posted December 9, 2016 Posted December 9, 2016 Revision of your second code... Although using (vl-some) in unusual way is inventive with 'ssget, I think that here is unnecessary and over programming situation... As you can see I've changed both my codes from previous post and now all 4 are compatible in a way that previous input can be used sequentially - only thing that user should look for is to nil global *n* variable after task(s) is(are) completed... Nice job, Marko! My second code obviously was a playaround with evaluations. ( I'd wrote it otherwise if I was after the practical performance: standard SS iteration, without (lambda) and SS vla object ). An advice for the global variable: try naming with something related to the routine, for example *TrimExtend:Variable* (because theres a possibility for a general global variable name to intersect with another, used in other loaded .lsp). Learned this from LM (atleast the way he globalises his variables). Regards, M.R. P.S. I don't know what did you wanted to say regarding PLINETOOLS - they are in my opinion correctly filled with all lisps it should have... Those lisps posted here are independent and may or may not be applied on POLYLINE entity(ies), so PLINETOOLS are separate story... Oh ok, that was just a suggestion. (I'm left with the impression that you are a master when a task is related to vlax-curve-*** functions/ geometrical routines). Cheers from Bulgaria! P.S. Overall I was just trying to help ziele_o2k, without ruining in any way Lee's reputation. Quote
Dana W Posted December 10, 2016 Posted December 10, 2016 "One cannot shorten a line just at the ends, one must shorten the whole line." I think that is a Yoda-ism. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.