缩短pline/lin的两端乐筑天下 - Powered by Discuz! Archiver

ziele_o2k 发表于 2022-7-5 16:52:47

缩短pline/lin的两端

我写了一些lisp来缩短pline/line的两端。
此例程基于“_.lengthen”命令，但有一个问题，使用此命令我无法缩短末端不在屏幕上的线/线。

如何不用（命令）实现我的目标，有什么建议吗？

Grrr 发表于 2022-7-5 17:01:17

你好
你是说像这样，但反过来？
你看过vlax曲线-****函数了吗？
编辑：顺便问一下，你想在两端缩短还是只在拾取的一端缩短？
编辑2：
无论如何，考虑一下：

; Trim Curve
(defun C:test ( / n pick e p spt ept )
(if (and (not (initget (+ 2 4))) (setq n (getreal "\nSpecify trim value <exit>: ")) )
(progn
(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 (cadr pick)) )
(cond
( (vlax-curve-isClosed e)
(princ "\nThis curve is closed, cannot be trimmed.")
)
(T
(if ; trim the picked side, to modify it to trim both sides: just remove/comment this (if) function, and the "T" symbol from the (cond)
(>=
(distance p (setq spt (vlax-curve-getPointAtParam e (vlax-curve-getStartParam e))))
(distance p (setq ept (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))))
)
(command "_.BREAK" (nentselp ept) "_non" (vlax-curve-getPointAtDist e (- (vlax-curve-getDistAtPoint e ept) n)) )
(command "_.BREAK" (nentselp spt) "_non" (vlax-curve-getPointAtDist e (+ (vlax-curve-getDistAtPoint e spt) n)) )
); if
)
); cond
)
(T nil)
); cond
); while
); progn
); if
(princ)
);| defun |; (vl-load-com) (princ)

编辑3：
我猜你在寻找这样的东西：

; Trim Curves - Both ends
(defun C:test ( / n Lst2 r )
(and (not (initget (+ 2 4)))(setq n (getreal "\nSpecify trim value <exit>: ")) )
(while
(and
n
(princ "\nSelect curves to trim: ")
(vl-some 'ssget (list "_I" "_:L"))
)
(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-getPointAtParam e (vlax-curve-getStartParam e)))
(setq ept (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e)))
)
(setq Lst2 (cons (list e spt ept) Lst2))
)
)
)
Lst
)
)
)
(vla-Delete SS)
)
(vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(vla-EndUndoMark (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" (vlax-curve-getPointAtDist (car x) (- r n)) )
)
(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" (vlax-curve-getPointAtDist (car x) (+ r n)) )
)
)
(vla-ZoomPrevious (vlax-get-acad-object))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
)
(princ)
);| defun |; (vl-load-com) (princ)

有些曲线有问题，IDK为什么。。虽然“屏幕问题”不是一个问题，因为缩放方法。

marko_ribar 发表于 2022-7-5 17:08:46

还有更多信息ab Lee的双扩展。。。
看这里-仅限沼泽会员。。。
https://www.theswamp.org/index.php?topic=49394.0

M、 R。

Grrr 发表于 2022-7-5 17:18:34

哦，很好，一个收缩选项！
顺便说一句，我忘了包括长度检查，如果修剪值大于实际的曲线长度。
在我看来，如果扩展是提示一个接一个地选择曲线上的一条边（就像我在这里上传的第一个gif的反面），那么它会更有用。

marko_ribar 发表于 2022-7-5 17:26:47

; 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。

Grrr 发表于 2022-7-5 17:32:10

含糖的
在我看来，这是一个可以添加到PLINETOOLS中的便捷工具。

marko_ribar 发表于 2022-7-5 17:42:29

修改第二个代码。。。虽然以不寻常的方式使用（vl-some）在“ssget”中具有创造性，但我认为这是不必要的和过度编程的情况。。。正如你们所见，我已经更改了前一篇文章中的两个代码，现在所有4个代码都兼容，可以顺序使用之前的输入-用户应该寻找的唯一一件事是在任务完成后将全局*n*变量置零。。。

; 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)
)

尊敬的M.R。
P、我不知道你想说什么关于PLINETOOLS-他们在我看来正确地填补了所有Lisp程序，它应该有。。。此处发布的Lisp是独立的，可能适用于也可能不适用于多段线实体，因此PLINETOOLS是独立的。。。

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

干得好，马尔科！
我的第二个代码显然是一个关于评估的游戏。（如果我在追求实际性能：标准SS迭代，没有（lambda）和SS vla对象，我会写其他内容）。
关于全局变量的建议：尝试使用与例程相关的东西命名，例如*TrimExtend:variable*
（因为通用全局变量名有可能与另一个相交，用于其他loaded.lsp）。这是从LM那里学到的（至少是他全球化变量的方式）。

哦，好的，那只是一个建议。（给我留下的印象是，当任务与vlax曲线-***函数/几何例程相关时，你就是大师）。
保加利亚欢呼！
P、总的来说，我只是想帮助ziele_o2k，而不会以任何方式破坏李的声誉。

Dana W 发表于 2022-7-5 17:58:26

“一个人不能只缩短一行的末尾，他必须缩短整行。”我认为这是尤达主义。

页: [1]

乐筑天下's Archiver

缩短pline/lin的两端