乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 25|回复： 10

[编程交流] 延伸或修剪到正交

[复制链接]
Simon1976

6

主题

25

帖子

19

银币

初来乍到

Rank: 1

铜币
30
发表于 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是否更接近拾取点
我目前的代码：
  2. (defun c:triangle (/ adj1 ang dist1 hyp1 hyp2 list1 ncos npt p1 p2 P3 pickpt)
  3.  (Setq pickpt (getpoint"\nSelect Pickpoint"))
  4.  (Setq p1 (getpoint"\nSelect Point 1"))
  5.  (Setq p2 (getpoint"\nSelect Point 2"))
  6.  (setq ang (angle p1 p2))
  7.  (setq list1 (list (car pickpt) (cadr p2) 0.0))
  8.  (setq hyp1 (distance p1 p2))
  9.  (setq dist1 (distance p2 list1))
  10. (setq adj1 (* hyp1 (cos ang)))
  11.  (if (< adj1 0.0)
  12.    (setq adj1 (* adj1 -1))
  13.  )
  14.  
  15. (setq ncos (cos ang))
  16. (setq hyp2 (/ dist1 ncos))
  17.  (if (< hyp2 0.0)
  18.    (setq hyp2 (* hyp2 -1))
  19.  )    
  20.  (if (< ncos 0.0)
  21.    (setq ncos (*(cos ang)-1))
  22.  )
  23. (setq npt (polar p2 ang hyp2))
  24.  (princ (strcat "\n npt is: "(rtos(car npt)) ", " (rtos(cadr npt)) ", " "0.0")); for testing
  25. (princ)
  26. )

 
 
但最后我在三角游戏中迷路了：-(
185352lnzsxdxxxdawpli7.jpg
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 18:01:15 | 显示全部楼层
我不太确定，但测试一下。。。
 
  2. (defun c:exttrimtoptucs ( / *adoc* *error* ucsf ss xr yr i li p1 p2 )
  4.  (vl-load-com)
  5.  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  7.  (defun *error* ( m )
  8.    (if ucsf
  9.      (command "_.UCS" "_P")
  10.    )
  11.    (if (entget xr)
  12.      (entdel xr)
  13.    )
  14.    (if (entget yr)
  15.      (entdel yr)
  16.    )
  17.    (vla-endundomark *adoc*)
  18.    (if m
  19.      (prompt m)
  20.    )
  21.    (princ)
  22.  )
  24.  (vla-startundomark *adoc*)
  25.  (if (= 0 (getvar 'worlducs))
  26.    (progn
  27.      (command "_.UCS" "_W")
  28.      (setq ucsf t)
  29.    )
  30.  )
  31.  (prompt "\nSelect LINEs to extend/trim to picked point...")
  32.  (cond
  33.    ( (setq ss (ssget "_:L" '((0 . "LINE"))))
  34.      (prompt "\nPick or specify point and choose X axis orientation : ")
  35.      (command "_.UCS")
  36.      (while (< 0 (getvar 'cmdactive))
  37.        (command "\")
  38.      )
  39.      (command "_.RAY" "_non" '(0.0 0.0 0.0) "_non" '(1.0 0.0 0.0) "")
  40.      (setq xr (entlast))
  41.      (command "_.RAY" "_non" '(0.0 0.0 0.0) "_non" '(0.0 1.0 0.0) "")
  42.      (setq yr (entlast))
  43.      (repeat (setq i (sslength ss))
  44.        (setq li (ssname ss (setq i (1- i))))
  45.        (setq p1 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object xr) acextendthisentity))
  46.        (if (null p1)
  47.          (setq p1 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object xr) acextendnone))
  48.        )
  49.        (setq p2 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object yr) acextendthisentity))
  50.        (if (null p2)
  51.          (setq p2 (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object yr) acextendnone))
  52.        )
  53.        (cond
  54.          ( (and p1 (not p2)
  55.              (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)
  56.              (> (car (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
  57.              (> (cadr (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
  58.            )
  59.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
  60.          )
  61.          ( (and p1 (not p2)
  62.              (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)
  63.              (> (car (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
  64.              (> (cadr (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
  65.            )
  66.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
  67.          )
  68.          ( (and (not p1) p2
  69.              (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)
  70.              (> (car (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
  71.              (> (cadr (trans (cdr (assoc 10 (entget li))) 0 1)) 0)
  72.            )
  73.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
  74.          )
  75.          ( (and (not p1) p2
  76.              (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)
  77.              (> (car (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
  78.              (> (cadr (trans (cdr (assoc 11 (entget li))) 0 1)) 0)
  79.            )
  80.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
  81.          )
  82.          ( (and p1 (not p2)
  83.              (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)
  84.            )
  85.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
  86.          )
  87.          ( (and p1 (not p2)
  88.              (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)
  89.            )
  90.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
  91.          )
  92.          ( (and (not p1) p2
  93.              (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)
  94.            )
  95.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
  96.          )
  97.          ( (and (not p1) p2
  98.              (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)
  99.            )
  100.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
  101.          )
  102.          ( (and p1 p2
  103.              (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)
  104.            )
  105.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
  106.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
  107.          )
  108.          ( (and p1 p2
  109.              (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)
  110.            )
  111.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
  112.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
  113.          )
  114.          ( (and p1 p2
  115.              (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)
  116.            )
  117.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
  118.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
  119.          )
  120.          ( (and p1 p2
  121.              (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)
  122.            )
  123.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
  124.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
  125.          )
  126.          ( (and p1 p2
  127.              (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
  128.              (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
  129.              (< (distance (cdr (assoc 10 (entget li))) p1) (distance (cdr (assoc 11 (entget li))) p1))
  130.              (< (distance (cdr (assoc 11 (entget li))) p2) (distance (cdr (assoc 10 (entget li))) p2))
  131.            )
  132.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 (entget li)) (entget li))))))
  133.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 (entget li)) (entget li))))))
  134.          )
  135.          ( (and p1 p2
  136.              (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 10 (entget li)))) (distance (cdr (assoc 10 (entget li))) p2)) 1e-6)
  137.              (equal (distance p1 p2) (+ (distance p1 (cdr (assoc 11 (entget li)))) (distance (cdr (assoc 11 (entget li))) p2)) 1e-6)
  138.              (< (distance (cdr (assoc 10 (entget li))) p2) (distance (cdr (assoc 11 (entget li))) p2))
  139.              (< (distance (cdr (assoc 11 (entget li))) p1) (distance (cdr (assoc 10 (entget li))) p1))
  140.            )
  141.            (entupd (cdr (assoc -1 (entmod (subst (cons 10 p2) (assoc 10 (entget li)) (entget li))))))
  142.            (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 (entget li)) (entget li))))))
  143.          )
  144.        )
  145.      )
  146.      (command "_.UCS" "_P")
  147.    )
  148.    ( t (prompt "\nEmpty sel.set... Retry routine next time..."))
  149.  )
  150.  (*error* nil)
  151. )

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

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 18:10:22 | 显示全部楼层
请尝试以下操作：
[code]（defunc:orthextrim（/enx ept idx lst pnt sel spt vec）（if（和（setqsel（ssget'（（0.“LINE”）））（setqpnt（=MAROON]“\n指定点：”））)（repeat[setq[[color]idx（sslength[[color]sel））（setq[[color]enx（entget[[color]（ssname[[color]sel（setq[[color]idx（1-idx）））spt（cdr[[color]（assoc[[color]10 enx））ept（cdr[[color](assoc[color]11 enx）vec（mapcar[color]'-spt ept）（if（cdr（setqlst（vl sort（vl remove if(lambda（x）（或[（
回复

使用道具 举报

Simon1976

6

主题

25

帖子

19

银币

初来乍到

Rank: 1

铜币
30
发表于 2022-7-5 18:15:45 | 显示全部楼层
我试图通过三角测量/三角法&一个极函数来求解它，似乎是找错了方向。我刚刚测试了你的代码Lee Mac&它运行得很好，非常感谢。也谢谢你，马克，我试过你的，但挂了几次。
 
 
-西蒙
回复

使用道具 举报

Happy Hobbit

21

主题

155

帖子

135

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
105
发表于 2022-7-5 18:21:26 | 显示全部楼层
这是个好主意，不幸的是，我两个代码都无法运行，我使用的是plain 2014。李的代码也停止了，它扩展或修剪了一行，但忽略了其他选定的行。在VLIDE中，它显示带括号的光标，就像等待AutoCAD执行某些操作一样。同上Markos代码。你是怎么让它工作的simon1976？
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 18:27:57 | 显示全部楼层
我的代码适用于我。。。何时发生悬挂？。。。您知道必须为UCS X、Y轴提供方向吗？。。。你所要做的就是选择线和拾取点，然后用第二个拾取提供X轴的方向（Y轴始终与X成逆时针90度），所以如果你想像图中那样，你应该在-90度处拾取第二个点，这样XDIR为（0-1）和YDIR（1 0）。。。
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 18:31:48 | 显示全部楼层
 
非常欢迎你，西蒙，这是一个很有趣的节目。
回复

使用道具 举报

Simon1976

6

主题

25

帖子

19

银币

初来乍到

Rank: 1

铜币
30
发表于 2022-7-5 18:41:09 | 显示全部楼层
你好，Marko
 
 
UCS总是世界级的&我从不更改它，lisp不会提示选择点来修剪/延伸直线（参见上图）&它似乎以错误的方式延伸直线
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

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

使用道具 举报

Grrr

66

主题

1552

帖子

1514

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
325
发表于 2022-7-5 18:51:56 | 显示全部楼层
嗨，西蒙，
我刚刚测试了Marko的代码。
首先，你需要选择你的台词，
然后，为了指定原点，在示例中选择“PICKPT”
然后指定第二个点，就像在示例中创建这些假想线之一一样
对于第三个点，点击这两条假想线之间的某个区域。
回复

使用道具 举报

12下一页
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-13 00:36 , Processed in 1.219877 second(s), 75 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表