本帖最后由 qifeifei 于 2025-6-27 13:43 编辑

平时做平面图衣柜
需要用到这个代码；使用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)

  6.   (vl-load-com)
  7.   (prompt "\n[T5] 开始运行命令...")

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

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

  29.           ;; 左右偏移
  30.           (vla-offset obj 18.0)
  31.           (setq rightEnt (entlast))
  32.           (vla-offset obj -18.0)
  33.           (setq leftEnt (entlast))

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

  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顺序

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

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

  65.                 ;; 执行 break
  66.                 (command "_.break" crossEnt ip1 ip2)
  67.                 (prompt "\n[T5] 成功剪切一条横线")
  68.                 (setq i (sslength allLines)) ; 跳出循环，只剪一条
  69.               )
  70.             )
  71.           )

  73.         )
  74.         (prompt "\n[T5] 请只选择一条竖向的 LINE 或 LWPOLYLINE.")
  75.       )
  76.     )
  77.     (prompt "\n[T5] 没有选择任何对象")
  78.   )
  79.   (princ)
  80. )
成功展示：



网友答: 太感动了 我终于研制成了


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

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

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

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

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

那等我空了 在研究下


网友答:
qifeifei 发表于 2025-6-27 20:18
好吧
我是有研究了部分；但是效果调试的不理想，才发出来
比较多的代码 我调试好的；我都自己用了 没 ...

;; 这种效果？




网友答:
xyp1964 发表于 2025-6-29 20:46
;; 这种效果？

大佬，求代码

网友答:
  2. ; --- 全局错误处理函数 ---
  3. (defun *error* (msg)
  4.   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
  5.     (princ (strcat "\n[Error] 程序出错或中断: " msg))
  6.   )
  7.   ; 恢复系统变量
  8.   (if *old_cmdecho* (setvar "CMDECHO" *old_cmdecho*))
  9.   (if *old_osmode* (setvar "OSMODE" *old_osmode*))
  10.   (princ)
  11. )

  13. ; --- 辅助函数：计算两条线段的交点 ---
  14. ; ent1, ent2: 实体名
  15. ; 返回: 交点坐标 (x y z) 或 nil
  16. (defun get_line_intersection (ent1 ent2 / data1 data2 pt10 pt11 pt20 pt21 inters_pt)
  17.   (setq data1 (entget ent1))
  18.   (setq data2 (entget ent2))
  19.   (setq pt10 (cdr (assoc 10 data1)))
  20.   (setq pt11 (cdr (assoc 11 data1)))
  21.   (setq pt20 (cdr (assoc 10 data2)))
  22.   (setq pt21 (cdr (assoc 11 data2)))
  23.   ; 计算线段交点 (nil 表示线段)
  24.   (setq inters_pt (inters pt10 pt11 pt20 pt21 nil))
  25.   inters_pt ; 返回交点或 nil
  26. )

  28. ; --- 主函数 ---
  29. (defun c:T5 (/ *old_cmdecho* *old_osmode* ss ent_original ent_data_original start_point_original end_point_original new_end_point mid_point_extended ent_left ent_right offset_dist selection_buffer ss_candidate_lines ent_hline pt_left pt_right i ent_check data_check pt1_check pt2_check mid_seg_ent_id found_mid_seg)
  30.   ; --- 保存系统变量 ---
  31.   (setq *old_cmdecho* (getvar "CMDECHO"))
  32.   (setq *old_osmode* (getvar "OSMODE"))
  33.   (setvar "CMDECHO" 0) ; 关闭命令行回显
  34.   (setvar "OSMODE" 0)  ; 关闭对象捕捉，确保点精确

  36.   ; --- 参数设置 ---
  37.   (setq offset_dist 18.0)       ; 偏移距离和延伸距离
  38.   (setq selection_buffer 50.0) ; 用于选择水平线的缓冲区大小

  40.   ; --- 1. 选择原始直线 ---
  41.   (princ "\n请选择一条直线: ")
  42.   (setq ss (ssget ":S" '((0 . "LINE")))) ; ":S" 限制只能选择一个实体

  44.   ; --- 2. 检查是否选择了对象 ---
  45.   (if ss
  46.     (progn
  47.       ; --- 3. 获取原始实体信息 ---
  48.       (setq ent_original (ssname ss 0))
  49.       (setq ent_data_original (entget ent_original))
  50.       (setq start_point_original (cdr (assoc 10 ent_data_original)))
  51.       (setq end_point_original (cdr (assoc 11 ent_data_original)))

  53.       ; --- 4. 延伸操作 (向北Y+) ---
  54.       ; 确定哪个端点是"北端点" (Y值较大)
  55.       (if (> (cadr start_point_original) (cadr end_point_original))
  56.         (progn
  57.           ; start_point_original 是北端点
  58.           (setq new_end_point (list (car start_point_original) (+ (cadr start_point_original) offset_dist) (caddr start_point_original)))
  59.           (setq ent_data_original (subst (cons 10 new_end_point) (assoc 10 ent_data_original) ent_data_original))
  60.           ; mid_point_extended 应该是原始线段的中点
  61.           (setq mid_point_extended (list
  62.                                      (/ (+ (car end_point_original) (car new_end_point)) 2.0)
  63.                                      (/ (+ (cadr end_point_original) (cadr new_end_point)) 2.0)
  64.                                      (/ (+ (caddr end_point_original) (caddr new_end_point)) 2.0)
  65.                                    )
  66.           )
  67.         )
  68.         (progn
  69.           ; end_point_original 是北端点
  70.           (setq new_end_point (list (car end_point_original) (+ (cadr end_point_original) offset_dist) (caddr end_point_original)))
  71.           (setq ent_data_original (subst (cons 11 new_end_point) (assoc 11 ent_data_original) ent_data_original))
  72.           ; mid_point_extended 应该是原始线段的中点
  73.           (setq mid_point_extended (list
  74.                                      (/ (+ (car start_point_original) (car new_end_point)) 2.0)
  75.                                      (/ (+ (cadr start_point_original) (cadr new_end_point)) 2.0)
  76.                                      (/ (+ (caddr start_point_original) (caddr new_end_point)) 2.0)
  77.                                    )
  78.           )
  79.         )
  80.       )
  81.       (entmod ent_data_original) ; 应用修改
  82.       (princ "\n[Info] 选定直线已向北延伸18个单位。")

  84.       ; --- 5. 向左偏移 ---
  85.       (setq offset_point_left (list (- (car mid_point_extended) offset_dist) (cadr mid_point_extended) (caddr mid_point_extended)))
  86.       (command "_.UNDO" "BE") ; 开始 UNDO 组
  87.       (command "_.OFFSET" offset_dist ent_original offset_point_left "")
  88.       (if (and (= (getvar 'CMDNAMES) "") (entlast)) ; 检查 OFFSET 是否成功
  89.         (progn
  90.           (setq ent_left (entlast))
  91.           (princ "\n[Info] 向左偏移18个单位完成。")
  92.         )
  93.         (princ "\n[Warning] 向左偏移可能失败。")
  94.       )

  96.       ; --- 6. 向右偏移 ---
  97.       (setq offset_point_right (list (+ (car mid_point_extended) offset_dist) (cadr mid_point_extended) (caddr mid_point_extended)))
  98.       (command "_.OFFSET" offset_dist ent_original offset_point_right "")
  99.       (if (and (= (getvar 'CMDNAMES) "") (entlast)) ; 检查 OFFSET 是否成功
  100.         (progn
  101.           (setq ent_right (entlast))
  102.           (princ "\n[Info] 向右偏移18个单位完成。")
  103.         )
  104.         (princ "\n[Warning] 向右偏移可能失败。")
  105.       )

  107.       ; --- 7. 打断并删除水平线中间段 ---
  108.       (princ "\n[Info] 开始查找并删除水平线中间段...")

  110.       ; --- 8. 计算选择窗口 ---
  111.       (setq min_x (- (car offset_point_left) selection_buffer))
  112.       (setq max_x (+ (car offset_point_right) selection_buffer))
  113.       (setq min_y (- (cadr mid_point_extended) selection_buffer))
  114.       (setq max_y (+ (cadr mid_point_extended) selection_buffer))
  115.       (setq corner1_window (list min_x max_y 0.0))   ; 左上
  116.       (setq corner2_window (list max_x min_y 0.0)) ; 右下

  118.       ; --- 9. 使用交叉窗口选择候选线 ---
  119.       (setq ss_candidate_lines (ssget "C" corner1_window corner2_window '((0 . "LINE"))))
  120.       
  121.       (if ss_candidate_lines
  122.         (progn
  123.           (princ (strcat "\n[Info] 找到 " (itoa (sslength ss_candidate_lines)) " 条候选线段。"))
  124.           (setq i 0)
  125.           (repeat (sslength ss_candidate_lines)
  126.             (setq ent_hline (ssname ss_candidate_lines i))

  128.             ; --- 10. 排除原始线、左偏移线、右偏移线本身 ---
  129.             (if (and (/= ent_hline ent_original) (/= ent_hline ent_left) (/= ent_hline ent_right))
  130.               (progn
  131.                 ; --- 11. 计算交点 ---
  132.                 (setq pt_left (get_line_intersection ent_hline ent_left))
  133.                 (setq pt_right (get_line_intersection ent_hline ent_right))

  135.                 ; --- 12. 如果与两条竖线都有交点 ---
  136.                 (if (and pt_left pt_right)
  137.                   (progn
  138.                     (princ (strcat "\n[Info] 处理水平线..."))

  140.                     ; --- 13. 执行两次打断 ---
  141.                     ; 使用 _non 过滤器确保点精确传递
  142.                     (command "_.BREAK" ent_hline (list '_non pt_left) (list '_non pt_left))
  143.                     (if (/= (getvar 'CMDNAMES) "")
  144.                       (princ "\n[Warning] 第一次 BREAK 可能失败。")
  145.                     )

  147.                     (command "_.BREAK" ent_hline (list '_non pt_right) (list '_non pt_right))
  148.                     (if (/= (getvar 'CMDNAMES) "")
  149.                       (princ "\n[Warning] 第二次 BREAK 可能失败。")
  150.                     )

  152.                     ; --- 14. 查找并删除中间段 ---
  153.                     ; 再次选择窗口内的线，查找端点为 P1 和 P2 的线段
  154.                     (setq ss_post_break (ssget "C" corner1_window corner2_window '((0 . "LINE"))))
  155.                     (setq found_mid_seg nil) ; 标记是否找到
  156.                     (if ss_post_break
  157.                       (progn
  158.                         (setq j 0)
  159.                         (repeat (sslength ss_post_break)
  160.                           (setq ent_check (ssname ss_post_break j))
  161.                           (setq data_check (entget ent_check))
  162.                           (setq pt1_check (cdr (assoc 10 data_check)))
  163.                           (setq pt2_check (cdr (assoc 11 data_check)))
  164.                           ; 检查端点是否为 P1 和 P2 (顺序无关，带容差)
  165.                           (if (or
  166.                                 (and (< (distance pt1_check pt_left) 1e-4) (< (distance pt2_check pt_right) 1e-4))
  167.                                 (and (< (distance pt1_check pt_right) 1e-4) (< (distance pt2_check pt_left) 1e-4))
  168.                               )
  169.                             (progn
  170.                               (setq found_mid_seg T)
  171.                               (entdel ent_check) ; 删除找到的中间段
  172.                               (princ "\n[Info] 已删除中间段。")
  173.                               (setq j (sslength ss_post_break)) ; 找到即退出
  174.                             )
  175.                           )
  176.                           (setq j (1+ j))
  177.                         ) ; repeat j
  178.                       ) ; progn if ss_post_break
  179.                     ) ; if ss_post_break
  180.                     (if (not found_mid_seg)
  181.                       (princ "\n[Warning] 未能找到中间段进行删除。")
  182.                     )

  184.                   ) ; if (and pt_left pt_right)
  185.                 ) ; if (/= ent_...)
  186.               ) ; progn
  187.             ) ; if ss_candidate_lines
  188.             (setq i (1+ i))
  189.           ) ; repeat i
  190.           (princ "\n[Info] 候选线处理完成。")
  191.         )
  192.         (princ "\n[Info] 未找到候选线段。")
  193.       ) ; if ss_candidate_lines

  195.       (command "_.UNDO" "E") ; 结束 UNDO 组
  196.       (command "_.REGEN") ; 最终重生成图形
  197.       (princ "\n[Info] 所有操作已完成。")
  198.     )
  199.     ; --- 如果没有选择对象 ---
  200.     (princ "\n[Error] 错误: 请先选择一条直线。")
  201.   )

  203.   ; --- 恢复系统变量 ---
  204.   (setvar "CMDECHO" *old_cmdecho*)
  205.   (setvar "OSMODE" *old_osmode*)
  206.   (princ)
  207. )

  209. (princ "\nT5命令已加载。命令: T5")
  210. (princ)
至少方向对了 回头在研究剪切
  • 上一篇：一键选中尺寸标注
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025