使用choosen在X轴上拉伸
开始了一个新的线程，因为它不在论坛的这一部分。在此处找到旧线程：http://www.cadtutor.net/forum/showthread.php?92554-在命令中添加命令行我现在尝试在这里合并Lee Mac的脚本，该脚本允许选择对象，然后像ACADs一样拉伸它们，仅在X轴上正常。（如果我修复了这个问题，我会在以后添加Y功能）
我已经注释掉了需要调整的部分。用我有限的LISP知识，我已经尽了最大努力。我的目标是将snapbase设置为pt1变量，并将其设置为gridx变量的所需值，然后以这些增量拉伸。
如果选择LockXOnly，则拉伸仅在X轴上发生。
任何帮助都将不胜感激。
以下是我目前掌握的信息：
(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 ? <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))
snapbase变量需要2d点值。
不确定这是否是你想要的：
(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 ? <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)
嗨，Grrr！
这正是我想要的。我非常感谢你写这封信。
出于某种原因，当我单击pt2时，它不会捕捉到网格。
我试着放在下面，但运气不好。
(setvar 'snapmode 1)
其他一些事情：
[列表]
[*]在选择pt2时，OSNAP似乎处于启用状态。能不能就为了这个而停下来，就为了选pt1而停下来。
[*]拾取pt2时，网格点不与间距（215、225、235或其他）对齐。
[*]如果运行命令，然后撤消。我的快照丢了？我在别处搜索过这个，但什么也没找到。
[/列表] 很乐意提供帮助，我对STRETCH命令和捕捉/网格变量都没有太多经验。
我不确定原因是什么，如上所述，我对这些变量没有太多经验。
也许其他人可以帮忙。
在我看来，“LockXOnly”模式不能正常工作，但我认为最好删除它？
修改了代码，现在将关闭。
修复了它，我对这段代码做了太多修改，最后没有执行全面检查。
编辑：你应该重新测试它并指出剩下的问题，希望其他人会帮助你。
祝你好运 太好了，谢谢。
该var为：
(setvar "gridunit" '(225 225))
我不确定我是否会把它加入到代码中，因为我以前在2d点上遇到过麻烦。
已编辑：
只是省略了它，因为无论如何都不需要显示它：
(list 'gridmode 1)
这是对LockXOnly>>LockInXYOnly的一个小小的修改和一个小小的拼写错误
还将其更改为按应有的半砖增量工作。
102.5mm:CO-
112.5mm:CO
122.5mm：CO+
CO表示协调大小。请参见此处。
并在选择LockInXYOnly时打开OSNAP，否则关闭：
(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 ? <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)
很抱歉
我说得太快了。我太激动了，因为它真的起作用了，我错过了最重要的事情。
协调大小是拉伸工作方式的关键。这仅适用于102.5mm、112.5和122.5，而不适用于其他选择。
从这里的表格中可以看出：http://www.ibstock.com/wp-content/uploads/2015/08/Ibstock-TIS-A2-BRICKWORK-DIMENSION-TABLES-Standard-brick-sizes.pdf
有CO-，CO和CO+
例如
CO+ CO CO-
122.5 112.5 102.5
235 225 215
460 450 440
.... ... ...
910 900 890
1022.5 1012.5 1002.5
CO总是比CO少10
CO+总是比CO多10。
因此，要将该变量设置为网格模块102.5/112.5/122.5等，无论网格代码变量分配给什么，都可以使用：
(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 'gridunit (if grid (list grid grid) (getvar 'gridunit)))
); list
); SetSvars
); setq snapvars
同时更改此选项，以提示输入非零正值，因为当2d点参数具有负值时，某些系统变量会崩溃：
( (wcmatch ansx "C*") (initget (+ 1 2 4)) (setq grid (getint "\nSpecify the brick size value:")) )
我不知道你这是什么意思。你想在某个地方改变代码的行为吗？
非常感谢您的修复。
是的，很不幸。
砖块课程分为C0、CO和CO+
不幸的是，如果没有这一更改，该命令将毫无用处。
来解释。
共同课程是。
102.5>215>327.5>440等等。。。
CO当然是。
112.5>225>337.5>450等等。。。
CO+当然是。
122.5>235>347.5>460等等。。。
正如你所看到的那样，CO将其原始值102.5添加到数组的每个元素中，并且每次在其上额外添加10mm。
CO是直接向前的，因为它只是为数组的每个元素添加其原始值。
CO+与CO-相似，但它只是在不同的初始值122.5mm处开始。
另外，我不知道在LISP中调用什么元素或数组，因为我使用的是maxscript的术语。我知道如何在Maxscript中向数组的每个元素添加数量。
在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
) LISP（列表处理）的功能是列表，尤其是关联列表。
看起来你有一些编程经验，
因此，您可能知道编写完整代码的任务之一是了解该语言的可能性，并写下要执行的步骤。
我会使用grread来处理整个事情，即：
首先是几个子功能：
(defun GetModeCO ( / Stop grr mode )
(princ "\nSpecify mode , to exit <CO>: ")
(while (not Stop)
(setq grr (grread))
(cond
( (= 2 (car grr))
(and
(setq mode (cdr (assoc (cadr grr) '((13 . "CO") (43 . "CO+") (45 . "CO-")))))
(princ (strcat "\nMode chosen: " mode "\n"))
(setq Stop T)
); and
)
( (= 25 (car grr)) (setq Stop T) )
); cond
); while
mode
); defun GetModeCO
(defun GetIncVal ( s i / n msg grr Stop pm )
(if (and (or (numberp s) (setq s 0.)) (numberp i))
(progn
(setq n s)
(princ (setq msg (strcat "\nStretching value: \"" (rtos (if n n s)) "\", use [+/-] to increase/decrease <exit>: ")))
(while (not Stop)
(setq grr (grread))
(cond
( (= 2 (car grr))
(and (= 13 (cadr grr)) (setq Stop T) )
(and
(setq pm (cdr (assoc (cadr grr) '((43 . +) (45 . -)))))
(setq n (apply pm (list n i)))
(princ (setq msg (strcat "\nStretching value: \"" (rtos (if n n s)) "\", use [+/-] to increase/decrease <exit>: ")))
); and
)
( (= 25 (car grr)) (setq Stop T) )
); cond
); while
n
); progn
); if
); defun GetIncVal
然后是测试功能：
(if
(and
;| 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... |;
(setq m (cadr (assoc (GetModeCO) (list '("CO" 102.5) '("CO+" 112.5) '("CO-" 122.5)))))
(setq n (GetIncVal m 112.5))
)
(alert (strcat "\nStretch value: " (rtos n)))
)
收集用户的输入相对容易，但我遇到的主要问题是实际的拉伸命令。
我做了很多尝试让它工作，但它总是不能“正常运行”。
也许这就是为什么你没有收到其他人的回复。 为_Stretch命令选择实体时，必须使用CW或CP。
页:
[1]
2