Stretch in X axis with choosen value in those increments

January 29, 2017

Started a new thread as it wasn't in this section of the forum. Old thread found here: http://www.cadtutor.net/forum/showthread.php?92554-Addition-in-commandline-while-in-command

I'm now trying to incorporate a script from Lee-Mac here which allows selecting the objects and then stretch them like ACADs normal behaviour in the X axis only. ( I will add Y functionality later if I get this fixed )

I've commented out the parts that need tweaking. I've taken it as far as I can with my limited knowledge of LISP. My aim is to set the snapbase to pt1 variable and set it to the required value of the gridx variable and then stretch in those increments.

If LockXOnly is chosen then stretch only happens in the X axis at any amount.

Any help would be greatly appreciated.

Here's what I have so far:

(defun c:bsx (/ *error* vl ov ss pt1 pt2 gmode gridx ansx)

(defun *error* (msg)
	(if ov (mapcar 'setvar vl ov))
	(if (not
		(wcmatch
			(strcase msg) "*CANCEL*,*EXIT*"))
	(princ (strcat "\n<< Error: " msg " >>")))
	(princ))

#| getvar and setq for below |#
(setq vl '("CMDECHO" "OSMODE" "GRIDSTYLE" "GRIDMODE" "SNAPBASE" "SNAPTYPE")
	ov (mapcar 'getvar vl))

(mapcar 'setvar vl '(0 255))

(initget "215mm 225mm 235mm Custom LockXOnly")
(setq ansx (getkword "\nX Brick Size ? [215mm/225mm/235mm/Custom/LockXOnly] <225mm>: "))
(cond
	(
		(= "215mm" ansx)
		(setq gridx 215)
		)
	(
		(= "225mm" ansx)
		(setq gridx 225)
		)
	(
		(= "235mm" ansx)
		(setq gridx 235)
		)
	(
		(= "Custom" ansx)
		(setq gridx (getint))
		)
	(
		(= "LockXOnly" ansx)
		; null, don't set any val for gridx
		)
	)

(if
	(setq ss (ssget))
	(if
		(and
			(setq pt1 (getpoint "\nSelect Base Point: "))
			(setq pt2 (getpoint pt1 "\nSelect Second Point: "))
			)
		(progn

			#| i want these lines below to run before |#
			#| the command for stretching. To set snapbase and snap to dims of brick course |#
			#| stretch amount. If you have a better method for this then all the better |#

			(command "SNAPBASE" pt1)
			(command "SNAP" gridx)
			(setvar "OSMODE" 0)
			(setvar "SNAPTYPE" 0)

			#| command stretch, need this to happen after setting gridsnap etc. |#
			(cond
				(
					(/= "LockXOnly" ansx) ; if distance is set
					(princ "\nLocked axis dim ON.")
					(command "_.STRETCH" ss "" pt1 ".x" pt2 0)
					(princ (strcat "\nStretched on X: " (rtos(- (car pt2) (car pt1)))))

					)
				(
					(= "LockXOnly" ansx) ; if no dis is set
					(command "_.STRETCH" ss "" pt1 ".x" pt2 0)
					(princ (strcat "\nStretched on X: " (rtos(- (car pt2) (car pt1)))))
					(princ "\nLocked axis dim OFF.")
					)
				)
			)
		)
	(princ "\n<< Nothing Selected >>")
	)

(mapcar 'setvar vl ov)
(princ))

January 29, 2017

The snapbase variable requires a 2d point value.

Not sure if this is what you're after:

(defun C:bsx ( / SetSvars *error* ansx SS snapvars pt1 pt2 grid st acDoc svars Y )
 
 (defun SetSvars ( L )
   (mapcar '(lambda (x / g) (if (cadr x) (progn (setq g (list (car x) (getvar (car x)))) (apply 'setvar x) g))) L)
 ); defun SetSvars
 
 (defun *error* (msg)
   (and snapvars (mapcar '(lambda (x) (apply 'setvar x)) snapvars))
   (and svars (mapcar '(lambda (x) (apply 'setvar x)) svars))
   (and acDoc (vla-EndUndoMark acDoc))
   (and msg (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")))
   (princ)
 ); defun *error*

 (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
 
 (cond
   (
     (not
       (and
         (not (initget "215mm 225mm 235mm Custom LockXOnly"))
         (setq ansx (cond ((getkword "\nX/Y Brick Size ? [215mm/225mm/235mm/Custom/LockXOnly] <225mm>: ")) ("225mm")))
         (progn
           (cond
             ( (wcmatch ansx "*mm") (setq grid (read (vl-string-right-trim "mm" ansx))) )
             ( (wcmatch ansx "C*") (initget (+ 1 2)) (setq grid (getint "\nSpecify the brick size value:")) )
             ( (wcmatch ansx "L*") (setq st T) )
           ); cond
           T
         ); progn
       ); and
     ); not
   )
   ( (not (and (princ "\nSelect objects to stretch: ") (setq SS (ssget "_:L")) ))
     (princ "\n<< Nothing Selected >>")
   )
   ( (not 
     (and 
       (setq pt1 (getpoint "\nSelect Base Point <exit>: ")) 
       (setq snapvars
         (SetSvars
           (list
           (list 'snapbase (if pt1 (list (car pt1) (cadr pt1)))) 
           (list 'snapmode 1) (list 'snaptype 0)  (list 'gridmode 1) 
           (list 'osmode 0)
           (if st (list 'snapstyl 1) (list 'orthomode 1))
           (list 'snapunit (if grid (list grid grid) (getvar 'snapunit))) (list 'gridstyle 1) 
         ); list
       ); SetSvars
       ); setq snapvars
       (setq pt2 (getpoint pt1 "\nSelect Second Point <exit>: "))
       ; (mapcar '(lambda (x) (set x (trans (vl-symbol-value x) 1 0))) '(pt1 pt2))
     )
   )
   (princ "\n<< Points were not specified >>")
   )
   (
     (progn 
       (setq svars (SetSvars (list (list 'cmdecho 0)))) ; keep in case of further modifications
       (if (wcmatch ansx "~L*") (princ "\nLocked axis dim ON.") (princ "\nLocked axis dim OFF.") )
       (and
         (initcommandversion)
         (if (setq Y (apply '< (reverse (cdr (reverse (mapcar 'abs (mapcar '- pt1 pt2)))))))
           (not (command "_.STRETCH" SS "" pt1 ".y" pt2 0.))
           (not (command "_.STRETCH" SS "" pt1 ".x" pt2 0.))
         )
         (princ (strcat "\nStretched on " (if Y "Y" "X") " by " (rtos (apply 'max (mapcar 'abs (mapcar '- pt1 pt2)))) " units."))
       )
     ); progn
   )
 ); cond
 (*error* nil)
 (princ)
); defun
(vl-load-com) (princ)

Edited January 29, 2017 by Grrr

January 29, 2017

Hi Grrr!

That's exactly what I was after. I can't thank you enough for writing this fn.

For some reason, it doesn't snap to the grid when I click for pt2.

I've tried to place below in there but no luck.

(setvar 'snapmode 1)

Some other things:

OSNAP seems to be on when picking pt2. Can this be off just for that and on for picking pt1.
The gridpoints don't line up with the spacing (215, 225, 235 or other) when picking pt2.
If run the command and then undo. My snaps are lost? I've search elsewhere on this but found nothing.

Edited January 29, 2017 by 3dwannab

January 29, 2017

Hi Grrr!

That's exactly what I was after. I can't thank you enough for writing this fn.

Happy to help, I don't have much experience with the STRETCH command, nor the snap/grid variables.

For some reason, it doesn't snap to the grid when I click for pt2.

I've tried to place
(setvar 'snapmode 1) 
in there but no luck.

I'm not sure whats the reason, as mentioned above, I don't have much experience with these variables.

Maybe someone else can help.

And IMO the "LockXOnly" mode doesn't work correctly, but I think its better to remove it?

OSSNAP seems to be on when picking pt2. Can this be off.

Modified the code, it will be off now.

Also, if run the command and then undo. My snaps are lost? I've search elsewhere on this but found nothing.

Fixed it, I did too much modifications on this code and didn't perform an overall check at the end.

EDIT: You should re-test it and point out the problems left, hopefully someone else will help.

Good luck!

January 29, 2017

Great, thank you.

That var for that is e.g:

(setvar "gridunit" '(225 225))

Not sure if I'll get that into the code as I had trouble with 2d points before.

EDITED:

Just omitted it from it as there's no need to display it anyway:

(list 'gridmode 1)

Here's that tiny change plus a tiny typo for LockXOnly >> LockInXYOnly

Also changed it to work in half brick increments like it should.

102.5mm:CO-

112.5mm:CO

122.5mm:CO+

CO meaning Coordinating Size. See here.

And turned on OSNAP when LockInXYOnly is selected and off when not:

(if (wcmatch ansx "~L*") (list 'osmode 0) (list 'osmode 1) )

(defun C:bs ( / SetSvars *error* ansx SS snapvars pt1 pt2 grid st acDoc svars Y )

(defun SetSvars ( L )
	(mapcar '(lambda (x / g) (if (cadr x) (progn (setq g (list (car x) (getvar (car x)))) (apply 'setvar x) g))) L)
 ); defun SetSvars

(defun *error* (msg)
	(and snapvars (mapcar '(lambda (x) (apply 'setvar x)) snapvars))
	(and svars (mapcar '(lambda (x) (apply 'setvar x)) svars))
	(and acDoc (vla-EndUndoMark acDoc))
	(and msg (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")))
	(princ)
 ); defun *error*

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

(cond
	(
		(not
			(and
				(not (initget "102.5mm:CO- 112.5mm:CO 122.5mm:CO+ Custom LockInXYOnly"))
				(setq ansx (cond ((getkword "\nX/Y Brick Size ? [102.5mm:CO-/112.5mm:CO/122.5mm:CO+/Custom/LockInXYOnly] <112.5mm:CO>: ")) ("112.5mm:CO")))
				(progn
					(cond
						( (wcmatch ansx "*mm:CO-") (setq grid (read (vl-string-right-trim "mm:CO-" ansx))) )
						( (wcmatch ansx "*mm:CO") (setq grid (read (vl-string-right-trim "mm:CO" ansx))) )
						( (wcmatch ansx "*mm:CO+") (setq grid (read (vl-string-right-trim "mm:CO+" ansx))) )
						( (wcmatch ansx "C*") (initget (+ 1 2)) (setq grid (getint "\nSpecify the brick size value:")) )
						( (wcmatch ansx "L*") (setq st T) )
           ); cond
					T
         ); progn
       ); and
     ); not
		)
	( (not (and (princ "\nSelect objects to stretch: ") (setq SS (ssget "_:L")) ))
		(princ "\n<< Nothing Selected >>")
		)
	( (not
		(and
			(setq pt1 (getpoint "\nSelect Base Point <exit>: "))
			(setq snapvars
				(SetSvars
					(list
						(list 'snapbase (if pt1 (list (car pt1) (cadr pt1))))
						(list 'snapmode 1) (list 'snaptype 0)  ;(list 'gridmode 1)
						(if (wcmatch ansx "~L*") (list 'osmode 0) (list 'osmode 1) )
						(if st (list 'snapstyl 1) (list 'orthomode 1))
						(list 'snapunit (if grid (list grid grid) (getvar 'snapunit))) (list 'gridstyle 1)
         ); list
       ); SetSvars
       ); setq snapvars
			(setq pt2 (getpoint pt1 "\nSelect Second Point <exit>: "))
       ; (mapcar '(lambda (x) (set x (trans (vl-symbol-value x) 1 0))) '(pt1 pt2))
       )
		)
	(princ "\n<< Points were not specified >>")
	)
	(
		(progn
       (setq svars (SetSvars (list (list 'cmdecho 0)))) ; keep in case of further modifications
       (if (wcmatch ansx "~L*") (princ "\nLocked axis dim ON.") (princ "\nLocked axis dim OFF.") )
       (and
       	(initcommandversion)
       	(if (setq Y (apply '< (reverse (cdr (reverse (mapcar 'abs (mapcar '- pt1 pt2)))))))
       		(not (command "_.STRETCH" SS "" pt1 ".y" pt2 0.))
       		(not (command "_.STRETCH" SS "" pt1 ".x" pt2 0.))
       		)
       	(princ (strcat "\nStretched on " (if Y "Y" "X") " by " (rtos (apply 'max (mapcar 'abs (mapcar '- pt1 pt2)))) " units."))
       	)
     ); progn
		)
 ); cond
(*error* nil)
(princ)
); defun
(vl-load-com) (princ)

Edited January 30, 2017 by 3dwannab

January 30, 2017

Sorry,

I spoke too soon. I was too excited that it actually worked I missed the most vital thing.

The Coordinating size is key to how the stretch works. This only applies to the 102.5mm, 112.5 & 122.5 and not the other choices.

As you can see from the table here: http://www.ibstock.com/wp-content/uploads/2015/08/Ibstock-TIS-A2-BRICKWORK-DIMENSION-TABLES-Standard-brick-sizes.pdf

There's CO-, CO & CO+

e.g.

CO+			CO			CO-
122.5			112.5			102.5
235			225			215 
460			450			440
....			...			...
910			900			890
1022.5			1012.5			1002.5

The CO- is always 10 less than CO

The CO+ is always 10 more than CO.

January 30, 2017

That var for that is e.g:
(setvar "gridunit" '(225 225))
Not sure if I'll get that into the code as I had trouble with 2d points before.

So to set this variable as the grid module 102.5/112.5/122.5 etc, whatever the grid code variable is assigned to, perhaps use:

(setq snapvars
 (SetSvars
   (list
     (list 'snapbase (if pt1 (list (car pt1) (cadr pt1))))
     (list 'snapmode 1) (list 'snaptype 0)  ;(list 'gridmode 1)
     (if (wcmatch ansx "~L*") (list 'osmode 0) (list 'osmode 1) )
     (if st (list 'snapstyl 1) (list 'orthomode 1))
     (list 'snapunit (if grid (list grid grid) (getvar 'snapunit))) (list 'gridstyle 1)
     [color=red](list 'gridunit (if grid (list grid grid) (getvar 'gridunit)))[/color]
   ); list
 ); SetSvars
); setq snapvars

Also change this, to prompt for non-zero positive values, since some system variables crash when the 2d point argument has a negative value:

( (wcmatch ansx "C*") (initget (+ 1 2 [color=red]4[/color])) (setq grid (getint "\nSpecify the brick size value:")) )

Sorry,

I spoke too soon. I was too excited that it actually worked I missed the most vital thing.

The Coordinating size is key to how the stretch works. This only applies to the 102.5mm, 112.5 & 122.5 and not the other choices.

As you can see from the table here: http://www.ibstock.com/wp-content/uploads/2015/08/Ibstock-TIS-A2-BRICKWORK-DIMENSION-TABLES-Standard-brick-sizes.pdf

There's CO-, CO & CO+

The CO- is always 10 less than CO

The CO+ is always 10 more than CO.

I'm not sure what you mean by this. You want to change the code's behaviour somewhere?

January 30, 2017

So to set this variable as the grid module 102.5/112.5/122.5 etc,
I'm not sure what you mean by this. You want to change the code's behaviour somewhere?

Thanks very much for the fixes.

Yeah, unfortunately.

With brick courses they go in C0-, CO and CO+

Without this change the command is no use, unfortunately.

To explain.

CO- course is.

102.5 > 215 > 327.5 > 440 and so on...

CO course is.

112.5 > 225 > 337.5 > 450 and so on...

CO+ course is.

122.5 > 235 > 347.5 > 460 and so on...

As you can see the CO- adds its orignal value of 102.5 to every element of the array and adds an additional 10mm on top of that every time.

CO is straight forward as it just adds its orignal value to itself for each elemant of the array.

CO+ is similar to CO- but it just starts of at a different initial value of 122.5mm.

PS. I don't know what element or array is called in LISP as I'm using the terms for maxscript. I know how to add amounts to each element of an array in Maxscript.

How something like this would be done in maxscript.

array = #()

for i = 1 to 100 do
(
   local val = 102.5
   append array (val += i += 10) -- add val to last element and add 10
)

January 30, 2017

The power of LISP (List Processing) are lists, especially the association lists.

Looks like you have some programmin' experience,

so you might know that one of the tasks to write a complete code is to know the language's possibilities, and write down the steps to be performed.

I would approach the whole thing using grread, i.e.:

First a couple of subfunctions:

[b][color=BLACK]([/color][/b]defun GetModeCO [b][color=FUCHSIA]([/color][/b] / Stop grr mode [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ [color=#2f4f4f]"\nSpecify mode [CO/CO+/CO-], [RMB] to exit <CO>: "[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not Stop[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq grr [b][color=MAROON]([/color][/b]grread[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]cond 
     [b][color=MAROON]([/color][/b] [b][color=GREEN]([/color][/b]= 2 [b][color=BLUE]([/color][/b]car grr[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]and
         [b][color=BLUE]([/color][/b]setq mode [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc [b][color=TEAL]([/color][/b]cadr grr[b][color=TEAL])[/color][/b] '[b][color=TEAL]([/color][/b][b][color=OLIVE]([/color][/b]13 . [color=#2f4f4f]"CO"[/color][b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]43 . [color=#2f4f4f]"CO+"[/color][b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]45 . [color=#2f4f4f]"CO-"[/color][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]
         [b][color=BLUE]([/color][/b]princ [b][color=RED]([/color][/b]strcat [color=#2f4f4f]"\nMode chosen: "[/color] mode [color=#2f4f4f]"\n"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b]setq Stop T[b][color=BLUE])[/color][/b]
       [b][color=GREEN])[/color][/b][color=#8b4513]; and[/color]
     [b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b] [b][color=GREEN]([/color][/b]= 25 [b][color=BLUE]([/color][/b]car grr[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq Stop T[b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b]
   [b][color=NAVY])[/color][/b][color=#8b4513]; cond[/color]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; while[/color]
 mode
[b][color=BLACK])[/color][/b][color=#8b4513]; defun GetModeCO[/color]

[b][color=BLACK]([/color][/b]defun GetIncVal [b][color=FUCHSIA]([/color][/b] s i / n msg grr Stop pm [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]numberp s[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq s 0.[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]numberp i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]progn
     [b][color=MAROON]([/color][/b]setq n s[b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]princ [b][color=GREEN]([/color][/b]setq msg [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nStretching value: \"[/color][color=#2f4f4f]" [b][color=RED]([/color][/b]rtos [b][color=PURPLE]([/color][/b]if n n s[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] "[/color]\[color=#2f4f4f]", use [+/-] to increase/decrease <exit>: "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]not Stop[b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]setq grr [b][color=BLUE]([/color][/b]grread[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]= 2 [b][color=PURPLE]([/color][/b]car grr[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]and [b][color=PURPLE]([/color][/b]= 13 [b][color=TEAL]([/color][/b]cadr grr[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]setq Stop T[b][color=PURPLE])[/color][/b] [b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]and
             [b][color=PURPLE]([/color][/b]setq pm [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc [b][color=GRAY]([/color][/b]cadr grr[b][color=GRAY])[/color][/b] '[b][color=GRAY]([/color][/b][b][color=AQUA]([/color][/b]43 . +[b][color=AQUA])[/color][/b] [b][color=AQUA]([/color][/b]45 . -[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]setq n [b][color=TEAL]([/color][/b]apply pm [b][color=OLIVE]([/color][/b]list n i[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]princ [b][color=TEAL]([/color][/b]setq msg [b][color=OLIVE]([/color][/b]strcat [color=#2f4f4f]"\nStretching value: \"[/color][color=#2f4f4f]" [b][color=GRAY]([/color][/b]rtos [b][color=AQUA]([/color][/b]if n n s[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] "[/color]\[color=#2f4f4f]", use [+/-] to increase/decrease <exit>: "[/color][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
           [b][color=RED])[/color][/b][color=#8b4513]; and[/color]
         [b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b] [b][color=RED]([/color][/b]= 25 [b][color=PURPLE]([/color][/b]car grr[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq Stop T[b][color=RED])[/color][/b] [b][color=BLUE])[/color][/b]
       [b][color=GREEN])[/color][/b][color=#8b4513]; cond[/color]
     [b][color=MAROON])[/color][/b][color=#8b4513]; while[/color]
     n
   [b][color=NAVY])[/color][/b][color=#8b4513]; progn[/color]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; if [/color]
[b][color=BLACK])[/color][/b][color=#8b4513]; defun GetIncVal[/color]

Then a test function:

[b][color=BLACK]([/color][/b]if
 [b][color=FUCHSIA]([/color][/b]and
   [color=#8b4513];| CO- course is: 102.5 > 215 > 327.5 > 440 and so on... [/color]
   CO course is: 112.5 > 225 > 337.5 > 450 and so on... 
   CO+ course is: 122.5 > 235 > 347.5 > 460 and so on... |[color=#8b4513];[/color]
   [b][color=NAVY]([/color][/b]setq m [b][color=MAROON]([/color][/b]cadr [b][color=GREEN]([/color][/b]assoc [b][color=BLUE]([/color][/b]GetModeCO[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]list '[b][color=RED]([/color][/b][color=#2f4f4f]"CO"[/color] 102.5[b][color=RED])[/color][/b] '[b][color=RED]([/color][/b][color=#2f4f4f]"CO+"[/color] 112.5[b][color=RED])[/color][/b] '[b][color=RED]([/color][/b][color=#2f4f4f]"CO-"[/color] 122.5[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][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]GetIncVal m 112.5[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
 [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]alert [b][color=NAVY]([/color][/b]strcat [color=#2f4f4f]"\nStretch value: "[/color] [b][color=MAROON]([/color][/b]rtos n[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b]

Its relatively easy to collect the user's inputs, but the main trouble I'm getting is with the actual STRETCH command.

I did a numerous attempts to get it work but it always doesn't "behave properly".

Maybe thats why you don't get replies from the others.

January 30, 2017

When selecting entities for the _Stretch command you have to use a CW or CP.

January 31, 2017

I do hope someone can help here Grrr. I wouldn't like your efforts to be in vain. My limits in LISP are limited as this initial fn was the first attempt at a working lisp.

I'd love to help you here but my knowledge isn't enough.

Hopefully Roy_043's answer is of some use.

I do like how the stretch works like the normal behaviour and it works with CP. But I noticed though it doesn't snap from a point after picking pt1 like the normal ACAD stretch.

That's just been super picky! I'd just like for the core functionality of it to work.

January 31, 2017

I would use a function to recalculate pt2 relative to pt1.

; Round half towards pos. or neg. infinity.
(defun Round (num)
 (fix ((if (minusp num) - +) num 0.5))
)

; Recalculate pt so that the X, Y and Z distance to base are n times dim.
(defun ModularizePoint (pt base dim)
 (mapcar
   '(lambda (coorPt coorBase)
     (+ coorBase (* dim (Round (/ (- coorPt coorBase) (float dim)))))
   )
   pt
   base
 )
)

(defun c:bsx (/ *error* vl ov ss pt1 pt2 gridx ansx)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>"))
   )
   (princ)
 )

 (setq vl '("CMDECHO"))
 (setq ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0))
 (if
   (and
     (princ "\nSelect entities to stretch by crossing-window or crossing-polygon: ")
     (setq ss (ssget))
     (setq pt1 (getpoint "\nSelect Base Point: "))
     (setq pt2 (getpoint pt1 "\nSelect Second Point: "))
   )
   (progn
     (initget "215mm 225mm 235mm Custom LockXOnly")
     (setq ansx (getkword "\nX Brick Size ? [215mm/225mm/235mm/Custom/LockXOnly] <225mm>: "))
     (cond
       ((or (not ansx) (= "215mm" ansx))
         (setq gridx 215)
       )
       ((= "225mm" ansx)
         (setq gridx 225)
       )
       ((= "235mm" ansx)
         (setq gridx 235)
       )
       ((= "Custom" ansx)
         (setq gridx (getint))
       )
     )
     (if gridx (setq pt2 (ModularizePoint pt2 pt1 gridx)))
     (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt1)))
     (princ
       (strcat
         "\nLocked axis dim " (if gridx "ON " "OFF ")
         "\nStretched on X: " (rtos (- (car pt2) (car pt1))) " "
       )
     )
   )
 )
 (mapcar 'setvar vl ov)
 (princ)
)

February 2, 2017

Thank you Roy_043.

Sorry I didn't get back sooner. I was off sick.

This is a different variation on Grrrs lisp. But unfortunately, it doesn't add or subtract 10mm from the CO dependant on whether it's CO- or CO+.

Could you add an option for the stretch before picking the objects so the stretch spans to the increments of the chosen brick course?

I'm attaching a dwg to illustrate more clearly how I want the stretch to work.

Brick Stretch Test.dwg

February 2, 2017

Try this:

(vl-load-com)

; Round half towards pos. or neg. infinity.
(defun Round (num)
 (fix ((if (minusp num) - +) num 0.5))
)

; Recalculate pt so that the X, Y and Z distance to base are n times module plus joint.
(defun ModularizePoint (pt base module joint)
 (mapcar
   '(lambda (coordPt coordBase)
     (+ coordBase joint (* module (Round (/ (- coordPt coordBase) (float module)))))
   )
   pt
   base
 )
)

(defun c:bsx (/ *error* doc ansx gridx jointx pt1 pt2 ss)

 (defun *error* (msg)
   (setvar 'cmdecho 1)
   (vla-endundomark doc)
   (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>"))
   )
   (princ)
 )

 (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (princ "\nSelect entities to stretch by crossing-window or crossing-polygon: ")
     (setq ss (ssget))
     (setq pt1 (getpoint "\nSelect Base Point: "))
     (setq pt2 (getpoint pt1 "\nSelect Second Point: "))
   )
   (progn
     (setvar 'cmdecho 0)
     (initget "Stand Min Plus Custom None")
     (setq ansx (getkword "\nX Brick Size (Standard=112.5 Joint=10)? [stand/stand Min joint/stand Plus joint/Custom/None] <Stand>: "))
     (cond
       ((or (not ansx) (= "Stand" ansx))
         (setq gridx 112.5)
         (setq jointx 0.0)
       )
       ((= "Min" ansx)
         (setq gridx 112.5)
         (setq jointx -10.0)
       )
       ((= "Plus" ansx)
         (setq gridx 112.5)
         (setq jointx 10.0)
       )
       ((= "Custom" ansx)
         (setq gridx (getreal "\nCustom size: "))
         (setq jointx 0.0)
       )
     )
     (if gridx (setq pt2 (ModularizePoint pt2 pt1 gridx jointx)))
     (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt1)))
     (princ
       (strcat
         "\nModular dimension: " (if gridx "ON " "OFF ")
         "\nStretched on X: " (rtos (- (car pt2) (car pt1))) " "
       )
     )
     (setvar 'cmdecho 1)
   )
 )
 (vla-endundomark doc)
 (princ)
)

February 2, 2017

Thanks. Great that's a step in the right direction.

There's a problem when it stretches in the negative X axis. See attached drawing to see problem.

Basically. Stretching in the X positive direction works but stretching in the negative direction is the opposite to the desired outcome. If I choose the +10mm option its -10mm and if -10mm it's the +10mm joint.

Is there any possible way to choose the joint type and then stretch snapping to the increments? No problem if not. Just would make it easier to see the final position of the stretch.

Brick Stretch Problem.dwg

February 6, 2017

Snapping to increments is problematic. If the joint is non-zero the snapbase would need to change depending on the direction of the stretch. The code below displays the grid (without taking the joint into account).

(vl-load-com)

; Round half towards pos. or neg. infinity.
(defun Round (num)
 (fix ((if (minusp num) - +) num 0.5))
)

; Recalculate pt so that the X, Y and Z distance to base are n times module plus joint.
(defun ModularizePoint (pt base module joint)
 (mapcar
   '(lambda (coordPt coordBase / delta)
     (setq delta (* module (Round (/ (- coordPt coordBase) (float module)))))
     (cond
       ((zerop delta)  coordBase)
       ((minusp delta) (+ coordBase delta (- joint)))
       (T              (+ coordBase delta joint))
     )
   )
   pt
   base
 )
)

(defun SetVars (lst)
 (mapcar
   '(lambda (sub / old)
     (setq old (getvar (car sub)))
     (if (cadr sub) (setvar (car sub) (cadr sub)))
     (list (car sub) old)
   )
   lst
 )
)

(defun c:bsx (/ *error* doc ansx gridx jointx pt1 pt2 ss vars)

 (defun *error* (msg)
   (if vars (SetVars vars))
   (vla-endundomark doc)
   (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>"))
   )
   (princ)
 )

 (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (princ "\nSelect entities to stretch by crossing-window or crossing-polygon: ")
     (setq ss (ssget))
     (progn
       (initget "Stand Minus Plus Custom None")
       (setq ansx (getkword "\nX Brick Size (Standard=112.5 Joint=10)? [stand/stand Minus joint/stand Plus joint/Custom/None] <Stand>: "))
       (cond
         ((or (not ansx) (= "Stand" ansx))
           (setq gridx 112.5)
           (setq jointx 0.0)
         )
         ((= "Minus" ansx)
           (setq gridx 112.5)
           (setq jointx -10.0)
         )
         ((= "Plus" ansx)
           (setq gridx 112.5)
           (setq jointx 10.0)
         )
         ((= "Custom" ansx)
           (setq gridx (getreal "\nCustom size: "))
           (setq jointx 0.0)
         )
       )
       T
     )
     (setq pt1 (getpoint "\nSelect Base Point: "))
     (setq vars
       (SetVars
         (if (= "None" ansx)
           '((cmdecho 0))
           (list
             '(cmdecho 0)
             (list 'snapbase pt1)
             '(griddisplay 1)
             '(gridmode 1)
             (list 'gridunit (list gridx gridx))
           )
         )
       )
     )
     (setq pt2 (getpoint pt1 "\nSelect Second Point: "))
   )
   (progn
     (if gridx (setq pt2 (ModularizePoint pt2 pt1 gridx jointx)))
     (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt1)))
     (princ
       (strcat
         "\nModular dimension: " (if gridx "ON " "OFF ")
         "\nStretched on X: " (rtos (- (car pt2) (car pt1))) " "
       )
     )
   )
 )
 (if vars (SetVars vars))
 (vla-endundomark doc)
 (princ)
)

February 6, 2017

I'm not at AutoCAD at the moment but over the weekend I was trying miserably to get your code to work.

I was trying to set the grid to the CO measurement if any of the brick options were chosen so that the stretch would follow that and depending on the chosen value at the start of the command, it would then subtract or add 10mm to the stretch.

The initial grid doesn't necessarily have to take the joint into account as its just for a rough guide but the final stretch will.

February 7, 2017

Snapping to increments is problematic. If the joint is non-zero the snapbase would need to change depending on the direction of the stretch. The code below displays the grid (without taking the joint into account).

(vl-load-com)

; Round half towards pos. or neg. infinity.
(defun Round (num)
 (fix ((if (minusp num) - +) num 0.5))
)

; Recalculate pt so that the X, Y and Z distance to base are n times module plus joint.
(defun ModularizePoint (pt base module joint)
 (mapcar
   '(lambda (coordPt coordBase / delta)
     (setq delta (* module (Round (/ (- coordPt coordBase) (float module)))))
     (cond
       ((zerop delta)  coordBase)
       ((minusp delta) (+ coordBase delta (- joint)))
       (T              (+ coordBase delta joint))
     )
   )
   pt
   base
 )
)

(defun SetVars (lst)
 (mapcar
   '(lambda (sub / old)
     (setq old (getvar (car sub)))
     (if (cadr sub) (setvar (car sub) (cadr sub)))
     (list (car sub) old)
   )
   lst
 )
)

(defun c:bsx (/ *error* doc ansx gridx jointx pt1 pt2 ss vars)

 (defun *error* (msg)
   (if vars (SetVars vars))
   (vla-endundomark doc)
   (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>"))
   )
   (princ)
 )

 (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (princ "\nSelect entities to stretch by crossing-window or crossing-polygon: ")
     (setq ss (ssget))
     (progn
       (initget "Stand Minus Plus Custom None")
       (setq ansx (getkword "\nX Brick Size (Standard=112.5 Joint=10)? [stand/stand Minus joint/stand Plus joint/Custom/None] <Stand>: "))
       (cond
         ((or (not ansx) (= "Stand" ansx))
           (setq gridx 112.5)
           (setq jointx 0.0)
         )
         ((= "Minus" ansx)
           (setq gridx 112.5)
           (setq jointx -10.0)
         )
         ((= "Plus" ansx)
           (setq gridx 112.5)
           (setq jointx 10.0)
         )
         ((= "Custom" ansx)
           (setq gridx (getreal "\nCustom size: "))
           (setq jointx 0.0)
         )
       )
       T
     )
     (setq pt1 (getpoint "\nSelect Base Point: "))
     (setq vars
       (SetVars
         (if (= "None" ansx)
           '((cmdecho 0))
           (list
             '(cmdecho 0)
             (list 'snapbase pt1)
             '(griddisplay 1)
             '(gridmode 1)
             (list 'gridunit (list gridx gridx))
           )
         )
       )
     )
     (setq pt2 (getpoint pt1 "\nSelect Second Point: "))
   )
   (progn
     (if gridx (setq pt2 (ModularizePoint pt2 pt1 gridx jointx)))
     (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt1)))
     (princ
       (strcat
         "\nModular dimension: " (if gridx "ON " "OFF ")
         "\nStretched on X: " (rtos (- (car pt2) (car pt1))) " "
       )
     )
   )
 )
 (if vars (SetVars vars))
 (vla-endundomark doc)
 (princ)
)

This has got the error:

Select Base Point:
<< Error: AutoCAD variable setting rejected: SNAPBASE (452.5 4278.5 0.0) >>

If it could work like post 17. I don't mind if the snap is not as per the choice of brick course.

See http://www.cadtutor.net/forum/showthread.php?99652-Stretch-in-X-axis-with-choosen-value-in-those-increments&p=678648&viewfull=1#post678648

February 7, 2017

This has got the error:

Select Base Point:
<< Error: AutoCAD variable setting rejected: SNAPBASE (452.5 4278.5 0.0) >>

Snapbase requires a 2d point:

Replace:

(list 'snapbase pt1)

with:

(list 'snapbase (reverse (cdr (reverse pt1))))

[s](list 'snapbase (vl-remove (last pt1) pt1))[/s]

_$ (setq pt (getpoint))
(0.0 0.0 0.0)
_$ (vl-remove (last pt) pt)
nil
_$

February 7, 2017

Thanks Grrr. BricsCAD accepts a 3D point here:

: (setvar 'snapbase '(1 2 3))
(1 2 3)
: (getvar 'snapbase)
(1.0 2.0)

Sign In

Stretch in X axis with choosen value in those increments

Recommended Posts

3dwannab

Grrr

3dwannab

Grrr

3dwannab

3dwannab

Grrr

3dwannab

Grrr

Roy_043

3dwannab

Roy_043

3dwannab

Roy_043

3dwannab

Roy_043

3dwannab

3dwannab

Grrr

Roy_043

Join the conversation

Tutorials

Forums

Activity