双线延申并偏移剪切

qifeifei

平时做平面图衣柜
需要用到这个代码；使用AI写的代码 调试了很多了 效果也不太理想
有时候可能达到自己想要的效果 有时候又抽风 求优化

2. (defun c:T5 (/ ss ent obj p1 p2 dir unit len p2new leftEnt rightEnt left right
   
3.                 newp1 newp2 mid allLines i crossEnt crossP1 crossP2 x1 x2
   
4.                 y1 y2 ip1 ip2)
   
5. 
   
6.   (vl-load-com)
   
7.   (prompt "\n[T5] 开始运行命令...")
   
8. 
   
9.   ;; 选择竖向直线
   
10.   (if (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
    
11.     (progn
    
12.       (setq ent (ssname ss 0)
    
13.             obj (vlax-ename->vla-object ent)
    
14.             p1 (vlax-get obj 'StartPoint)
    
15.             p2 (vlax-get obj 'EndPoint)
    
16.             dir (mapcar '- p2 p1)
    
17.             len (distance p1 p2))
    
18. 
    
19.       ;; 判断竖线
    
20.       (if (< (abs (car dir)) 0.01)
    
21.         (progn
    
22.           (setq unit (mapcar '(lambda (x) (/ x len)) dir))
    
23.           (setq p2new (mapcar '+ p2 (mapcar '(lambda (x) (* x 18.0)) unit)))
    
24.           (vlax-put obj 'EndPoint p2new)
    
25.           (prompt (strcat "\n[T5] 已延申到新终点: "
    
26.                           (rtos (car p2new) 2 2) ", "
    
27.                           (rtos (cadr p2new) 2 2)))
    
28. 
    
29.           ;; 左右偏移
    
30.           (vla-offset obj 18.0)
    
31.           (setq rightEnt (entlast))
    
32.           (vla-offset obj -18.0)
    
33.           (setq leftEnt (entlast))
    
34. 
    
35.           ;; 获取偏移线坐标
    
36.           (setq right (vlax-ename->vla-object rightEnt))
    
37.           (setq left  (vlax-ename->vla-object leftEnt))
    
38.           (setq newp1 (vlax-get obj 'StartPoint))
    
39.           (setq newp2 (vlax-get obj 'EndPoint))
    
40.           (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) newp1 newp2))
    
41. 
    
42.           ;; 获取左右偏移的X范围
    
43.           (setq x1 (car (vlax-get left 'StartPoint)))
    
44.           (setq x2 (car (vlax-get right 'StartPoint)))
    
45.           (if (> x1 x2) (setq tmp x1 x1 x2 x2 tmp)) ; 交换x1 x2顺序
    
46. 
    
47.           ;; 查找在左右偏移线之间的横线
    
48.           (setq allLines (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
    
49.           (setq i -1)
    
50.           (while (and allLines (setq crossEnt (ssname allLines (setq i (1+ i)))))
    
51.             (setq crossObj (vlax-ename->vla-object crossEnt))
    
52.             (setq crossP1 (vlax-get crossObj 'StartPoint))
    
53.             (setq crossP2 (vlax-get crossObj 'EndPoint))
    
54. 
    
55.             ;; 横向判断：y 坐标相同，x 跨越 x1 ~ x2
    
56.             (if (and (equal (cadr crossP1) (cadr crossP2) 0.01)
    
57.                      (< (min (car crossP1) (car crossP2)) x1)
    
58.                      (> (max (car crossP1) (car crossP2)) x2))
    
59.               (progn
    
60.                 ;; 计算交点：在左右偏移线 x1 和 x2 的交点处 break
    
61.                 (setq y (cadr crossP1))
    
62.                 (setq ip1 (list x1 y 0.0))
    
63.                 (setq ip2 (list x2 y 0.0))
    
64. 
    
65.                 ;; 执行 break
    
66.                 (command "_.break" crossEnt ip1 ip2)
    
67.                 (prompt "\n[T5] 成功剪切一条横线")
    
68.                 (setq i (sslength allLines)) ; 跳出循环，只剪一条
    
69.               )
    
70.             )
    
71.           )
    
72. 
    
73.         )
    
74.         (prompt "\n[T5] 请只选择一条竖向的 LINE 或 LWPOLYLINE.")
    
75.       )
    
76.     )
    
77.     (prompt "\n[T5] 没有选择任何对象")
    
78.   )
    
79.   (princ)
    
80. )
    

(defun c:T5 (/ ss ent obj p1 p2 dir unit len p2new leftEnt rightEnt left right<br />                 newp1 newp2 mid allLines i crossEnt crossP1 crossP2 x1 x2<br />                 y1 y2 ip1 ip2)<br /> <br />   (vl-load-com)<br />   (prompt "\n[T5] 开始运行命令...")<br /> <br />   ;; 选择竖向直线<br />   (if (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))<br />     (progn<br />       (setq ent (ssname ss 0)<br />             obj (vlax-ename->vla-object ent)<br />             p1 (vlax-get obj 'StartPoint)<br />             p2 (vlax-get obj 'EndPoint)<br />             dir (mapcar '- p2 p1)<br />             len (distance p1 p2))<br /> <br />       ;; 判断竖线<br />       (if (< (abs (car dir)) 0.01)<br />         (progn<br />           (setq unit (mapcar '(lambda (x) (/ x len)) dir))<br />           (setq p2new (mapcar '+ p2 (mapcar '(lambda (x) (* x 18.0)) unit)))<br />           (vlax-put obj 'EndPoint p2new)<br />           (prompt (strcat "\n[T5] 已延申到新终点: "<br />                           (rtos (car p2new) 2 2) ", "<br />                           (rtos (cadr p2new) 2 2)))<br /> <br />           ;; 左右偏移<br />           (vla-offset obj 18.0)<br />           (setq rightEnt (entlast))<br />           (vla-offset obj -18.0)<br />           (setq leftEnt (entlast))<br /> <br />           ;; 获取偏移线坐标<br />           (setq right (vlax-ename->vla-object rightEnt))<br />           (setq left  (vlax-ename->vla-object leftEnt))<br />           (setq newp1 (vlax-get obj 'StartPoint))<br />           (setq newp2 (vlax-get obj 'EndPoint))<br />           (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) newp1 newp2))<br /> <br />           ;; 获取左右偏移的X范围<br />           (setq x1 (car (vlax-get left 'StartPoint)))<br />           (setq x2 (car (vlax-get right 'StartPoint)))<br />           (if (> x1 x2) (setq tmp x1 x1 x2 x2 tmp)) ; 交换x1 x2顺序<br /> <br />           ;; 查找在左右偏移线之间的横线<br />           (setq allLines (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))<br />           (setq i -1)<br />           (while (and allLines (setq crossEnt (ssname allLines (setq i (1+ i)))))<br />             (setq crossObj (vlax-ename->vla-object crossEnt))<br />             (setq crossP1 (vlax-get crossObj 'StartPoint))<br />             (setq crossP2 (vlax-get crossObj 'EndPoint))<br /> <br />             ;; 横向判断：y 坐标相同，x 跨越 x1 ~ x2<br />             (if (and (equal (cadr crossP1) (cadr crossP2) 0.01)<br />                      (< (min (car crossP1) (car crossP2)) x1)<br />                      (> (max (car crossP1) (car crossP2)) x2))<br />               (progn<br />                 ;; 计算交点：在左右偏移线 x1 和 x2 的交点处 break<br />                 (setq y (cadr crossP1))<br />                 (setq ip1 (list x1 y 0.0))<br />                 (setq ip2 (list x2 y 0.0))<br /> <br />                 ;; 执行 break<br />                 (command "_.break" crossEnt ip1 ip2)<br />                 (prompt "\n[T5] 成功剪切一条横线")<br />                 (setq i (sslength allLines)) ; 跳出循环，只剪一条<br />               )<br />             )<br />           )<br /> <br />         )<br />         (prompt "\n[T5] 请只选择一条竖向的 LINE 或 LWPOLYLINE.")<br />       )<br />     )<br />     (prompt "\n[T5] 没有选择任何对象")<br />   )<br />   (princ)<br /> )<br />

成功展示：

你有种再说一遍

哈哈,怎么感觉现在还比以前糟糕,以前都是求代码,
起码大家的代码都没有问题.

现在是拿着代码让别人改,别人还得从头看一次你的代码,
你代码的函数又不是别人的函数库,还得从头学一次.

真的把这个工作想得太简单了...
不是懂代码的用这个工具会让全部人都感受到痛苦.

qifeifei

你有种再说一遍 发表于 2025-6-27 18:03
哈哈,怎么感觉现在还比以前糟糕,以前都是求代码,
起码大家的代码都没有问题.

好吧
我是有研究了部分；但是效果调试的不理想，才发出来
比较多的代码 我调试好的；我都自己用了 没发了

那等我空了 在研究下