使用choosen在X轴上拉伸乐筑天下 - Powered by Discuz! Archiver

3dwannab 发表于 2022-7-5 17:17:13

我真的希望有人能帮我。我不希望你的努力白费。我在LISP中的限制是有限的，因为最初的fn是第一次尝试使用LISP。

我很乐意帮你，但我的知识还不够。

希望罗伊043的回答有一些用处。

我确实喜欢拉伸的工作方式，像正常行为一样，它与CP一起工作。但我注意到，虽然在拾取pt1后，它不会像正常的ACAD拉伸那样从一个点开始断裂。

太挑剔了！我只想让它的核心功能发挥作用。

Roy_043 发表于 2022-7-5 17:18:37

我将使用一个函数来重新计算相对于pt1的pt2。
; 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 ? <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)
)

3dwannab 发表于 2022-7-5 17:22:29

谢谢Roy_043。

对不起，我没有早点回来。我生病了。

这是Grrrs lisp的不同变体。但不幸的是，它不能根据CO-或CO+来增加或减少10mm。

在拾取对象之前，是否可以添加拉伸选项，使拉伸跨越到所选砖层的增量？

我附加了一个dwg，以更清楚地说明我希望拉伸如何工作。
砖拉伸试验。图纸

Roy_043 发表于 2022-7-5 17:25:48

试试这个：
(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>: "))
(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)
)

3dwannab 发表于 2022-7-5 17:28:56

谢谢太好了，这是朝着正确方向迈出的一步。

当它在负X轴上拉伸时会出现问题。请参阅附图以查看问题。

大体上在X正方向拉伸有效，但在负方向拉伸与预期结果相反。如果我选择+10mm选项，则为-10mm，如果为-10mm，则为+10mm接头。

是否有任何可能的方法来选择关节类型，然后拉伸捕捉到增量？如果没有，也没问题。这样可以更容易地看到拉伸的最终位置。
砖拉伸问题。图纸

Roy_043 发表于 2022-7-5 17:34:17

捕捉到增量是有问题的。如果关节不为零，则需要根据拉伸方向更改snapbase。下面的代码显示网格（不考虑关节）。

(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>: "))
   (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)
)

3dwannab 发表于 2022-7-5 17:34:47

我现在不在AutoCAD，但在周末，我痛苦地试图让你的代码正常工作。

我试图将网格设置为共测量，如果选择了任何砖块选项，则拉伸将遵循该选项，并根据命令开始时选择的值，然后将拉伸减去或添加10mm。

初始网格不一定要考虑关节，因为它只是一个粗略的引导，但最终拉伸将。

3dwannab 发表于 2022-7-5 17:39:25

出现错误：
Select Base Point:
<< Error: AutoCAD variable setting rejected: SNAPBASE (452.5 4278.5 0.0) >>

如果它能像17号岗位那样工作。我不介意扣子是否与砖层的选择不符。

看见http://www.cadtutor.net/forum/showthread.php?99652-X轴拉伸-带-choosen-value-in-they-increments&p=678648&viewfull=1#post678648

Grrr 发表于 2022-7-5 17:41:48

Snapbase需要二维点：
替换：
(list 'snapbase pt1)
使用：
(list 'snapbase (reverse (cdr (reverse pt1))))

(list 'snapbase (vl-remove (last pt1) pt1))

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

Roy_043 发表于 2022-7-5 17:44:46

谢谢Grrr。BricsCAD在此处接受三维点：
: (setvar 'snapbase '(1 2 3))
(1 2 3)
: (getvar 'snapbase)
(1.0 2.0)

页: 1 [2]

乐筑天下's Archiver