延伸或修剪到正交乐筑天下 - Powered by Discuz! Archiver

Simon1976 发表于 2022-7-5 17:53:51

延伸或修剪到正交

请问有没有人有点Lisp程序的延伸/修剪？
这肯定是以前做过，但我找不到它，尽管谷歌搜索彻底。
这是我的第一篇帖子&我希望我正确地添加了jpg
功能：
选择点（var pickpt）
将选定线延伸或修剪到pickpt的正交投影
终止
在图片中，黄色虚线是pickpt的正交投影，洋红是要延伸/修剪的线。
我希望实际的扩展修剪通过重复循环完成，新端点通过极轴函数创建，列表创建，然后子函数创建
（subst lst（assoc 10 linedxf）
或
（subst lst（assoc 11 linedxf）
取决于assoc 10或assoc 11是否更接近拾取点
我目前的代码：

(defun c:triangle (/ adj1 ang dist1 hyp1 hyp2 list1 ncos npt p1 p2 P3 pickpt)
(Setq pickpt (getpoint"\nSelect Pickpoint"))
(Setq p1 (getpoint"\nSelect Point 1"))
(Setq p2 (getpoint"\nSelect Point 2"))
(setq ang (angle p1 p2))
(setq list1 (list (car pickpt) (cadr p2) 0.0))
(setq hyp1 (distance p1 p2))
(setq dist1 (distance p2 list1))
(setq adj1 (* hyp1 (cos ang)))
(if (< adj1 0.0)
(setq adj1 (* adj1 -1))
)

(setq ncos (cos ang))
(setq hyp2 (/ dist1 ncos))
(if (< hyp2 0.0)
(setq hyp2 (* hyp2 -1))
)
(if (< ncos 0.0)
(setq ncos (*(cos ang)-1))
)
(setq npt (polar p2 ang hyp2))
(princ (strcat "\n npt is: "(rtos(car npt)) ", " (rtos(cadr npt)) ", " "0.0")); for testing
(princ)
)

但最后我在三角游戏中迷路了：-(

marko_ribar 发表于 2022-7-5 18:01:15

我不太确定，但测试一下。。。

(defun c:exttrimtoptucs ( / *adoc* *error* ucsf ss xr yr i li p1 p2 )

(vl-load-com)
(setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))

(defun *error* ( m )
(if ucsf
(command "_.UCS" "_P")
)
(if (entget xr)
(entdel xr)
)
(if (entget yr)
(entdel yr)
)
(vla-endundomark *adoc*)
(if m
(prompt m)
)
(princ)
)

(vla-startundomark *adoc*)
(if (= 0 (getvar 'worlducs))
(progn
(command "_.UCS" "_W")
(setq ucsf t)
)
)
(prompt "\nSelect LINEs to extend/trim to picked point...")
(cond
( (setq ss (ssget "_:L" '((0 . "LINE"))))
(prompt "\nPick or specify point and choose X axis orientation : ")
(command "_.UCS")
(while (< 0 (getvar 'cmdactive))
   (command "\\")
)
(command "_.RAY" "_non" '(0.0 0.0 0.0) "_non" '(1.0 0.0 0.0) "")
(setq xr (entlast))
(command "_.RAY" "_non" '(0.0 0.0 0.0) "_non" '(0.0 1.0 0.0) "")
(setq yr (entlast))
(repeat (setq i (sslength ss))
   (setq li (ssname ss (setq i (1- i))))
   (setq p1 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object xr) acextendthisentity))
   (if (null p1)
      (setq p1 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object xr) acextendnone))
   )
   (setq p2 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object yr) acextendthisentity))
   (if (null p2)
      (setq p2 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object yr) acextendnone))
   )
   (cond
      ( (and p1 (not p2)
         (equal (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (+ (distance (cdr (assoc 10 (entget li))) p1) (distance p1 (cdr (assoc 11 (entget li))))) 1e-6)
         (> (car (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
         (> (cadr (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and p1 (not p2)
         (equal (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (+ (distance (cdr (assoc 10 (entget li))) p1) (distance p1 (cdr (assoc 11 (entget li))))) 1e-6)
         (> (car (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
         (> (cadr (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and (not p1) p2
         (equal (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (+ (distance (cdr (assoc 10 (entget li))) p2) (distance p2 (cdr (assoc 11 (entget li))))) 1e-6)
         (> (car (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
         (> (cadr (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and (not p1) p2
         (equal (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (+ (distance (cdr (assoc 10 (entget li))) p2) (distance p2 (cdr (assoc 11 (entget li))))) 1e-6)
         (> (car (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
         (> (cadr (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and p1 (not p2)
         (equal (distance (cdr (assoc 11 (entget li))) p1) (+ (distance (cdr (assoc 11 (entget li))) (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p1)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and p1 (not p2)
         (equal (distance (cdr (assoc 10 (entget li))) p1) (+ (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p1)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and (not p1) p2
         (equal (distance (cdr (assoc 11 (entget li))) p2) (+ (distance (cdr (assoc 11 (entget li))) (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and (not p1) p2
         (equal (distance (cdr (assoc 10 (entget li))) p2) (+ (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance (cdr (assoc 11 (entget li))) p1) (+ (distance (cdr (assoc 11 (entget li))) (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p1)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance (cdr (assoc 10 (entget li))) p1) (+ (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p1)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance (cdr (assoc 11 (entget li))) p2) (+ (distance (cdr (assoc 11 (entget li))) (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance (cdr (assoc 10 (entget li))) p2) (+ (distance (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
         (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
         (< (distance (cdr (assoc 10 (entget li))) p1) (distance (cdr (assoc 11 (entget li))) p1))
         (< (distance (cdr (assoc 11 (entget li))) p2) (distance (cdr (assoc 10 (entget li))) p2))
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
      )
      ( (and p1 p2
         (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
         (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
         (< (distance (cdr (assoc 10 (entget li))) p2) (distance (cdr (assoc 11 (entget li))) p2))
         (< (distance (cdr (assoc 11 (entget li))) p1) (distance (cdr (assoc 10 (entget li))) p1))
      )
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
      (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
      )
   )
)
(command "_.UCS" "_P")
)
( t (prompt "\nEmpty sel.set... Retry routine next time..."))
)
(*error* nil)
)

HTH，M.R。
向所有76岁的一代（我也是）。。。

Lee Mac 发表于 2022-7-5 18:10:22

请尝试以下操作：
（defunc:orthextrim（/enx ept idx lst pnt sel spt vec）（if（和（setqsel（ssget'（（0.“LINE”）））（setqpnt（=MAROON]“\n指定点：”））)（repeat[setq[idx（sslength[sel））（setq[enx（entget[（ssname[sel（setq[idx（1-idx）））spt（cdr[（assoc[10 enx））ept（cdr[(assoc11 enx）vec（mapcar'-spt ept）（if（cdr（setqlst（vl sort（vl remove if(lambda（x）（或[（

Simon1976 发表于 2022-7-5 18:15:45

我试图通过三角测量/三角法&一个极函数来求解它，似乎是找错了方向。我刚刚测试了你的代码Lee Mac&它运行得很好，非常感谢。也谢谢你，马克，我试过你的，但挂了几次。

-西蒙

Happy Hobbit 发表于 2022-7-5 18:21:26

这是个好主意，不幸的是，我两个代码都无法运行，我使用的是plain 2014。李的代码也停止了，它扩展或修剪了一行，但忽略了其他选定的行。在VLIDE中，它显示带括号的光标，就像等待AutoCAD执行某些操作一样。同上Markos代码。你是怎么让它工作的simon1976？

marko_ribar 发表于 2022-7-5 18:27:57

我的代码适用于我。。。何时发生悬挂？。。。您知道必须为UCS X、Y轴提供方向吗？。。。你所要做的就是选择线和拾取点，然后用第二个拾取提供X轴的方向（Y轴始终与X成逆时针90度），所以如果你想像图中那样，你应该在-90度处拾取第二个点，这样XDIR为（0-1）和YDIR（1 0）。。。

Lee Mac 发表于 2022-7-5 18:31:48

非常欢迎你，西蒙，这是一个很有趣的节目。

Simon1976 发表于 2022-7-5 18:41:09

你好，Marko

UCS总是世界级的&我从不更改它，lisp不会提示选择点来修剪/延伸直线（参见上图）&它似乎以错误的方式延伸直线

marko_ribar 发表于 2022-7-5 18:45:53

有没有可能没有人理解写的代码。。。我已经解释了lisp的工作原理，您必须选择直线，然后选择2个点（X轴方向的基点和秒）。。。然后，Lisp正在构造要计算修剪/延伸的2个光线实体。。。最后，UCS返回到以前的方向，并删除光线，使线图元修改（修剪/扩展）为完全先前定义的光线（UCS的方向）。。。所以它的作用与图片中相同，您只需要提供正确的方向XDIR（0-1）YDIR（1 0）。。。更重要的是，你可以指定任何其他你想要执行动作的方向，因此，我的版本比李的更一般。。。

Grrr 发表于 2022-7-5 18:51:56

嗨，西蒙，
我刚刚测试了Marko的代码。
首先，你需要选择你的台词，
然后，为了指定原点，在示例中选择“PICKPT”
然后指定第二个点，就像在示例中创建这些假想线之一一样
对于第三个点，点击这两条假想线之间的某个区域。

页: [1] 2

乐筑天下's Archiver

延伸或修剪到正交