控制线段移动的距离的问题

qifeifei

学会了 但是我又了新的想法 我双线偏移18 但是要如何剪切掉中间那部分
没研究出来

2. (defun c:T5 (/ ss i ent obj p1 p2 vec len unit p2new rightObj leftObj
   
3.                pR1 pR2 midR pL1 pL2 midL trimP1 trimP2)
   
4. 
   
5.   (setq extend-dist 18.0)
   
6. 
   
7.   (prompt "\n请选择直线（LINE）：")
   
8. 
   
9.   ;; 获取用户选中的主线
   
10.   (if (setq ss (ssget '((0 . "LINE"))))
    
11.     (progn
    
12.       (setq i -1)
    
13.       (while (setq ent (ssname ss (setq i (1+ i))))
    
14.         (setq obj (vlax-ename->vla-object ent))
    
15.         (setq p1 (vlax-get obj 'StartPoint))
    
16.         (setq p2 (vlax-get obj 'EndPoint))
    
17. 
    
18.         ;; 单位向量
    
19.         (setq vec (mapcar '- p2 p1))
    
20.         (setq len (distance p1 p2))
    
21. 
    
22.         (if (zerop len)
    
23.           (prompt "\n跳过长度为0的线段。")
    
24.           (progn
    
25.             ;; 延申终点
    
26.             (setq unit (mapcar '(lambda (x) (/ x len)) vec))
    
27.             (setq p2new (mapcar '+ p2 (mapcar '(lambda (x) (* x extend-dist)) unit)))
    
28.             (vlax-put obj 'EndPoint p2new)
    
29. 
    
30.             ;; 左右偏移
    
31.             (setq rightObj (car (vlax-invoke obj 'Offset 18.0)))
    
32.             (setq leftObj  (car (vlax-invoke obj 'Offset -18.0)))
    
33. 
    
34.             ;; 取两条偏移线的起点和终点
    
35.             (setq pR1 (vlax-get rightObj 'StartPoint))
    
36.             (setq pR2 (vlax-get rightObj 'EndPoint))
    
37.             (setq pL1 (vlax-get leftObj  'StartPoint))
    
38.             (setq pL2 (vlax-get leftObj  'EndPoint))
    
39. 
    
40.             ;; 取交点范围的两个中点，用作 TRIM 的两个点
    
41.             (setq trimP1 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pR1 pR2))
    
42.             (setq trimP2 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pL1 pL2))
    
43. 
    
44.             ;; 执行自动 TRIM，剪掉中间横线
    
45.             (command "_.trim" "" (list trimP1 trimP2) "")  ; 注意这里的点用于裁剪横线
    
46.           )
    
47.         )
    
48.       )
    
49.     )
    
50.     (prompt "\n未选择任何 LINE。")
    
51.   )
    
52. 
    
53.   (princ)
    
54. )
    

(defun c:T5 (/ ss i ent obj p1 p2 vec len unit p2new rightObj leftObj<br />                pR1 pR2 midR pL1 pL2 midL trimP1 trimP2)<br /> <br />   (setq extend-dist 18.0)<br /> <br />   (prompt "\n请选择直线（LINE）：")<br /> <br />   ;; 获取用户选中的主线<br />   (if (setq ss (ssget '((0 . "LINE"))))<br />     (progn<br />       (setq i -1)<br />       (while (setq ent (ssname ss (setq i (1+ i))))<br />         (setq obj (vlax-ename->vla-object ent))<br />         (setq p1 (vlax-get obj 'StartPoint))<br />         (setq p2 (vlax-get obj 'EndPoint))<br /> <br />         ;; 单位向量<br />         (setq vec (mapcar '- p2 p1))<br />         (setq len (distance p1 p2))<br /> <br />         (if (zerop len)<br />           (prompt "\n跳过长度为0的线段。")<br />           (progn<br />             ;; 延申终点<br />             (setq unit (mapcar '(lambda (x) (/ x len)) vec))<br />             (setq p2new (mapcar '+ p2 (mapcar '(lambda (x) (* x extend-dist)) unit)))<br />             (vlax-put obj 'EndPoint p2new)<br /> <br />             ;; 左右偏移<br />             (setq rightObj (car (vlax-invoke obj 'Offset 18.0)))<br />             (setq leftObj  (car (vlax-invoke obj 'Offset -18.0)))<br /> <br />             ;; 取两条偏移线的起点和终点<br />             (setq pR1 (vlax-get rightObj 'StartPoint))<br />             (setq pR2 (vlax-get rightObj 'EndPoint))<br />             (setq pL1 (vlax-get leftObj  'StartPoint))<br />             (setq pL2 (vlax-get leftObj  'EndPoint))<br /> <br />             ;; 取交点范围的两个中点，用作 TRIM 的两个点<br />             (setq trimP1 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pR1 pR2))<br />             (setq trimP2 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pL1 pL2))<br /> <br />             ;; 执行自动 TRIM，剪掉中间横线<br />             (command "_.trim" "" (list trimP1 trimP2) "")  ; 注意这里的点用于裁剪横线<br />           )<br />         )<br />       )<br />     )<br />     (prompt "\n未选择任何 LINE。")<br />   )<br /> <br />   (princ)<br /> )<br />

qifeifei

chenlianghuai 发表于 2025-6-24 12:21
小伙子不错，有前途

您好 请教一下新的问题 延申后怎么自动剪切

xyp1964

;; 双向偏移交点修剪

bai2000

xyp1964 发表于 2025-6-24 14:29
;; 双向偏移交点修剪

很好，求院长分享，，，

qifeifei

bai2000 发表于 2025-6-24 15:05
很好，求院长分享，，，

AI 帮我写出来了 分享给你 但是目前来看 不太稳定 需要加固

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

(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 />

437271963

(defun c:tt ( / &kw ent ent2 obj ss x)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(princ "\n请选择直线，多段线，样条曲线，圆弧，圆，椭圆。")
(if (setq &kw (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
  (progn
   (setq ss '());空表，记录未成功偏移的图元
   (while (setq ent (ssname &kw 0))
    (setq &kw (ssdel ent &kw) obj (vlax-ename->vla-object ent));这样写，是为了防止删除图元后造成错误
    (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list obj 9)));正向偏移9;防止偏移错误，造成程序中断
     (progn
      (setq ent2 nil);如果没有偏移成功就提示
      (setq ss (cons ent ss));如果未偏移成功就记录
     )
     (progn
      (setq ent2 (entlast));偏移成功的话，就记录这个图元
      (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-offset (list obj -9)));反向偏移9
       (progn
        (entdel ent2);反向偏移未成功，就删除已经偏移的对象
        (setq ss (cons ent ss));如果未偏移成功就记录
       )
       (vla-delete obj);如果双向偏移成功，就删除原来的图元
      )
     )
    )
   );while
   (if (car ss);如果有未偏移成功的图元
    (progn
     (princ (strcat "\n共有:<" (itoa (length ss)) ">个图元不能双向偏移"))
     (setq &kw (ssadd))
     (mapcar '(lambda(x) (ssadd x &kw)) ss)
     (sssetfirst nil &kw);图元亮显选择
    )
   )
  )
)
(princ)
)
;优化了使用过程当中产生的错误