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

qifeifei

让ai帮我写一个Autodesk cad lsp代码 命令是lp
视图固定在上  是二维画图 需求是 选择一根线或者线段 line or pline
让选择的线copy 往左边移动18 然后选选中初始线与复制出来的线 往右移动9


但是ai写的非常的失败 根本不能稳定稳定运行 有没有大神可以帮助修改下

1. (defun cP (/ sel entType copiedEnt ss)
   
2.   (prompt "\n请选择一条 LINE 或 LWPOLYLINE 线段：")
   
3.   (setq sel (car (entsel)))
   
4.   
   
5.   (if (and sel
   
6.            (setq entType (cdr (assoc 0 (entget sel))))
   
7.            (or (equal entType "LINE") (equal entType "LWPOLYLINE")))
   
8.     (progn
   
9.       ;; 明确使用坐标偏移，不依赖选择点
   
10.       (command "_.COPY" sel "" '(0 0 0) '(-18 0 0))
    
11.       (setq copiedEnt (entlast))
    
12. 
    
13.       ;; 使用精确选择集控制两个对象
    
14.       (setq ss (ssadd))
    
15.       (ssadd sel ss)
    
16.       (ssadd copiedEnt ss)
    
17. 
    
18.       ;; 向右移动 9 单位
    
19.       (command "_.MOVE" ss "" '(0 0 0) '(9 0 0))
    
20. 
    
21.       (prompt "\n✔ 线段处理完成。")
    
22.     )
    
23.     (prompt "\n⚠ 请选择一条 LINE 或 LWPOLYLINE 线段。")
    
24.   )
    
25.   (princ)
    
26. )
    

(defun c<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />P (/ sel entType copiedEnt ss)<br />   (prompt "\n请选择一条 LINE 或 LWPOLYLINE 线段：")<br />   (setq sel (car (entsel)))<br />   <br />   (if (and sel<br />            (setq entType (cdr (assoc 0 (entget sel))))<br />            (or (equal entType "LINE") (equal entType "LWPOLYLINE")))<br />     (progn<br />       ;; 明确使用坐标偏移，不依赖选择点<br />       (command "_.COPY" sel "" '(0 0 0) '(-18 0 0))<br />       (setq copiedEnt (entlast))<br /> <br />       ;; 使用精确选择集控制两个对象<br />       (setq ss (ssadd))<br />       (ssadd sel ss)<br />       (ssadd copiedEnt ss)<br /> <br />       ;; 向右移动 9 单位<br />       (command "_.MOVE" ss "" '(0 0 0) '(9 0 0))<br /> <br />       (prompt "\n&#10004; 线段处理完成。")<br />     )<br />     (prompt "\n&#9888; 请选择一条 LINE 或 LWPOLYLINE 线段。")<br />   )<br />   (princ)<br /> )<br />

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

chenlianghuai

(defun c:lP (/ ss i ent entData entType p1 p2 dx dy copyEnt tempSS)
  (prompt "\n 请选择一条或多条 LINE 或 LWPOLYLINE 线段：")
  (setq ss (ssget '((0 . "LINE,LWPOLYLINE")))) ; 支持多选线段

  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq entData (entget ent))
        (setq entType (cdr (assoc 0 entData)))

        ;; 获取起点和终点
        (cond
          ((equal entType "LINE")
           (setq p1 (cdr (assoc 10 entData)))
           (setq p2 (cdr (assoc 11 entData)))
          )
          ((equal entType "LWPOLYLINE")
           ;; 取前两个点
           (setq p1 (cdr (assoc 10 entData)))
           (setq p2 (cdr (assoc 10 (nth 1 entData))))
          )
        )

        ;; 判断方向
        (setq dx (abs (- (car p2) (car p1))))
        (setq dy (abs (- (cadr p2) (cadr p1))))

        ;; 执行复制与移动
        (cond
          ((> dy dx)
           ;; 竖直线处理
           (command "_.COPY" ent "" "non" '(0 0 0) "non" '(-18 0 0))
           (setq copyEnt (entlast))
           (setq tempSS (ssadd))
           (ssadd ent tempSS)
           (ssadd copyEnt tempSS)
           (command "_.MOVE" tempSS "" "non" '(0 0 0) "non" '(9 0 0))
          )
          ((>= dx dy)
           ;; 横线处理
           (command "_.COPY" ent "" "non" '(0 0 0) "non" '(0 -18 0))
           (setq copyEnt (entlast))
           (setq tempSS (ssadd))
           (ssadd ent tempSS)
           (ssadd copyEnt tempSS)
           (command "_.MOVE" tempSS "" "non" '(0 0 0) "non" '(0 9 0))
          )
        )

        (setq i (1+ i))
      )
      (prompt (strcat "\n&#10004; 成功处理 " (itoa (sslength ss)) " 条线段。"))
    )
    (prompt "\n&#9888; 没有选择任何有效线段。")
  )
  (princ)
)

qifeifei

我已经成功让ai帮我修复好了 亲测可以用了
但是偶尔还是有点小bug 不管了 先用
或者有大师可以帮忙修复升级下
----

1. (defun cP (/ ss i ent entData entType p1 p2 dx dy copyEnt tempSS)
   
2.   (prompt "\n请选择一条或多条 LINE 或 LWPOLYLINE 线段：")
   
3.   (setq ss (ssget '((0 . "LINE,LWPOLYLINE")))) ; 支持多选线段
   
4. 
   
5.   (if ss
   
6.     (progn
   
7.       (setq i 0)
   
8.       (while (< i (sslength ss))
   
9.         (setq ent (ssname ss i))
   
10.         (setq entData (entget ent))
    
11.         (setq entType (cdr (assoc 0 entData)))
    
12. 
    
13.         ;; 获取起点和终点
    
14.         (cond
    
15.           ((equal entType "LINE")
    
16.            (setq p1 (cdr (assoc 10 entData)))
    
17.            (setq p2 (cdr (assoc 11 entData)))
    
18.           )
    
19.           ((equal entType "LWPOLYLINE")
    
20.            ;; 取前两个点
    
21.            (setq p1 (cdr (assoc 10 entData)))
    
22.            (setq p2 (cdr (assoc 10 (nth 1 entData))))
    
23.           )
    
24.         )
    
25. 
    
26.         ;; 判断方向
    
27.         (setq dx (abs (- (car p2) (car p1))))
    
28.         (setq dy (abs (- (cadr p2) (cadr p1))))
    
29. 
    
30.         ;; 执行复制与移动
    
31.         (cond
    
32.           ((> dy dx)
    
33.            ;; 竖直线处理
    
34.            (command "_.COPY" ent "" '(0 0 0) '(-18 0 0))
    
35.            (setq copyEnt (entlast))
    
36.            (setq tempSS (ssadd))
    
37.            (ssadd ent tempSS)
    
38.            (ssadd copyEnt tempSS)
    
39.            (command "_.MOVE" tempSS "" '(0 0 0) '(9 0 0))
    
40.           )
    
41.           ((>= dx dy)
    
42.            ;; 横线处理
    
43.            (command "_.COPY" ent "" '(0 0 0) '(0 -18 0))
    
44.            (setq copyEnt (entlast))
    
45.            (setq tempSS (ssadd))
    
46.            (ssadd ent tempSS)
    
47.            (ssadd copyEnt tempSS)
    
48.            (command "_.MOVE" tempSS "" '(0 0 0) '(0 9 0))
    
49.           )
    
50.         )
    
51. 
    
52.         (setq i (1+ i))
    
53.       )
    
54.       (prompt (strcat "\n&#10004; 成功处理 " (itoa (sslength ss)) " 条线段。"))
    
55.     )
    
56.     (prompt "\n&#9888; 没有选择任何有效线段。")
    
57.   )
    
58.   (princ)
    
59. )
    

(defun c<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />P (/ ss i ent entData entType p1 p2 dx dy copyEnt tempSS)<br />   (prompt "\n请选择一条或多条 LINE 或 LWPOLYLINE 线段：")<br />   (setq ss (ssget '((0 . "LINE,LWPOLYLINE")))) ; 支持多选线段<br /> <br />   (if ss<br />     (progn<br />       (setq i 0)<br />       (while (< i (sslength ss))<br />         (setq ent (ssname ss i))<br />         (setq entData (entget ent))<br />         (setq entType (cdr (assoc 0 entData)))<br /> <br />         ;; 获取起点和终点<br />         (cond<br />           ((equal entType "LINE")<br />            (setq p1 (cdr (assoc 10 entData)))<br />            (setq p2 (cdr (assoc 11 entData)))<br />           )<br />           ((equal entType "LWPOLYLINE")<br />            ;; 取前两个点<br />            (setq p1 (cdr (assoc 10 entData)))<br />            (setq p2 (cdr (assoc 10 (nth 1 entData))))<br />           )<br />         )<br /> <br />         ;; 判断方向<br />         (setq dx (abs (- (car p2) (car p1))))<br />         (setq dy (abs (- (cadr p2) (cadr p1))))<br /> <br />         ;; 执行复制与移动<br />         (cond<br />           ((> dy dx)<br />            ;; 竖直线处理<br />            (command "_.COPY" ent "" '(0 0 0) '(-18 0 0))<br />            (setq copyEnt (entlast))<br />            (setq tempSS (ssadd))<br />            (ssadd ent tempSS)<br />            (ssadd copyEnt tempSS)<br />            (command "_.MOVE" tempSS "" '(0 0 0) '(9 0 0))<br />           )<br />           ((>= dx dy)<br />            ;; 横线处理<br />            (command "_.COPY" ent "" '(0 0 0) '(0 -18 0))<br />            (setq copyEnt (entlast))<br />            (setq tempSS (ssadd))<br />            (ssadd ent tempSS)<br />            (ssadd copyEnt tempSS)<br />            (command "_.MOVE" tempSS "" '(0 0 0) '(0 9 0))<br />           )<br />         )<br /> <br />         (setq i (1+ i))<br />       )<br />       (prompt (strcat "\n&#10004; 成功处理 " (itoa (sslength ss)) " 条线段。"))<br />     )<br />     (prompt "\n&#9888; 没有选择任何有效线段。")<br />   )<br />   (princ)<br /> )<br />

uualice2020

不就是双向偏移吗

xyp1964

1. (defun c:tt ()
   
2.   "双向偏移"
   
3.   (princ "\n请选择 LINE 或 LWPOLYLINE 线段<退出>：")
   
4.   (while (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
   
5.     (setq i -1)
   
6.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.       (xyp-Offset s1 9 t t t)
   
8.     )
   
9.   )
   
10.   (princ)
    
11. )

(defun c:tt ()<br />   "双向偏移"<br />   (princ "\n请选择 LINE 或 LWPOLYLINE 线段<退出>：")<br />   (while (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (xyp-Offset s1 9 t t t)<br />     )<br />   )<br />   (princ)<br /> )

1. (defun c:tt ()
   
2.   "双向偏移"
   
3.   (princ "\n请选择 LINE 或 LWPOLYLINE 线段<退出>：")
   
4.   (while (setq ss (ssget '((0 . "LINE,*POLYLINE,arc,circle"))))
   
5.     (setq i -1)
   
6.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.       (setq ob(vlax-ename->vla-object s1))
   
8.       (vla-offset ob 9)
   
9.       (vla-offset ob -9)
   
10.       (vla-delete ob)
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt ()<br />   "双向偏移"<br />   (princ "\n请选择 LINE 或 LWPOLYLINE 线段<退出>：")<br />   (while (setq ss (ssget '((0 . "LINE,*POLYLINE,arc,circle"))))<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq ob(vlax-ename->vla-object s1))<br />       (vla-offset ob 9)<br />       (vla-offset ob -9)<br />       (vla-delete ob)<br />     )<br />   )<br />   (princ)<br /> )

qazxswk

双向偏移，当年我学习写代码接触的第一个插件

chenlianghuai

qifeifei 发表于 2025-6-23 12:59
我已经成功让ai帮我修复好了 亲测可以用了
但是偶尔还是有点小bug 不管了 先用
或者有大师可以帮忙修 ...

双向偏移，还可以了，继续努力

437271963

xyp1964 发表于 2025-6-23 20:54

你要给他完整代码，偏移命令
(vla-offset obj 9);偏移9
(vla-offset obj -9);偏移-9
(vla-delete obj);删除原来图元
适用所有曲线，不需要分析方向

嘒彼小星

437271963 发表于 2025-6-24 09:37
你要给他完整代码，偏移命令
(vla-offset obj 9);偏移9
(vla-offset obj -9);偏移-9

分析了半天 还是你这个来得快。给大佬补全一下子。应该就是这样。

2. (defun c:tt(/ ss i obj_n)
   
3.         (if(setq ss(ssget '((0 . "LINE,LWPOLYLINE"))) i 0)
   
4.                 (progn
   
5.                         (command "UNDO" "be")
   
6.                         (repeat(sslength ss)
   
7.                                 (setq obj_n (vlax-ename->vla-object (ssname ss i)))
   
8.                                 (vla-offset obj_n 9)
   
9.                                 (vla-offset obj_n -9)
   
10.                                 (vla-Delete obj_n)
    
11.                                 (setq i(1+ i))
    
12.                         )
    
13.                         (command "UNDO" "e")
    
14.                 )
    
15.         )
    
16. )

(defun c:tt(/ ss i obj_n)<br />         (if(setq ss(ssget '((0 . "LINE,LWPOLYLINE"))) i 0)<br />                 (progn<br />                         (command "UNDO" "be")<br />                         (repeat(sslength ss)<br />                                 (setq obj_n (vlax-ename->vla-object (ssname ss i)))<br />                                 (vla-offset obj_n 9)<br />                                 (vla-offset obj_n -9)<br />                                 (vla-Delete obj_n)<br />                                 (setq i(1+ i))<br />                         )<br />                         (command "UNDO" "e")<br />                 )<br />         )<br /> )

chenlianghuai

嘒彼小星 发表于 2025-6-24 10:14
分析了半天 还是你这个来得快。给大佬补全一下子。应该就是这样。

小伙子不错，有前途