本帖最后由 yanshengjiang 于 2025-10-13 12:00 编辑

翻阅电脑找到一个lsp源代码“为阀门和水泵添加扩展数据.lsp”
测试一番发现可以改成下面这个功能，经过deepseek润色。    没仔细测试，请明友帮忙反馈下bug
  1. ; 重新设计 entsel2 函数，支持多种调用方式
  2. ; (entsel2 msg) - 只提供提示信息
  3. ; (entsel2 filter-list) - 只提供过滤条件  
  4. ; (entsel2 (list msg filter-list)) - 同时提供提示信息和过滤条件
  5. ;; 1. 只提供提示信息
  6. ;;(entsel2 "请选择一条直线:")
  7. ;; 2. 只提供过滤条件  
  8. ;;(entsel2 '((0 . "LINE") (8 . "0")))
  9. ;; 3. 同时提供提示信息和过滤条件
  10. ;;(entsel2 (list "选择0层上的圆:" '((0 . "CIRCLE") (8 . "0"))))
  11. (defun entsel2 (arg / jspt gr code pt ss ent oldent loop d ptlst result msg filter-list)
  12.   ;; 内部函数：计算点偏移
  13.   (defun jspt (pt w ww)
  14.     (list (+ (car pt) w) (+ (cadr pt) ww))
  15.   )

  17.   ;; 解析参数 - 支持多种调用方式
  18.   (setq msg nil
  19.         filter-list nil)
  20.   
  21.   (cond
  22.     ; 情况1: 参数是字符串 -> 只设置提示信息
  23.     ((= (type arg) 'STR)
  24.      (setq msg arg))
  25.    
  26.     ; 情况2: 参数是列表（过滤条件）-> 只设置过滤条件
  27.     ((and (= (type arg) 'LIST)
  28.           (not (and (= (length arg) 2)
  29.                     (= (type (car arg)) 'STR))))
  30.      (setq filter-list arg))
  31.    
  32.     ; 情况3: 参数是包含2个元素的列表，且第一个是字符串 -> 提示信息和过滤条件
  33.     ((and (= (type arg) 'LIST)
  34.           (= (length arg) 2)
  35.           (= (type (car arg)) 'STR))
  36.      (setq msg (car arg)
  37.            filter-list (cadr arg)))
  38.    
  39.     ; 情况4: 其他情况（如 nil 或无效参数）
  40.     (t
  41.      (setq msg nil filter-list nil))
  42.   )

  44.   ;; 显示提示信息
  45.   (if msg(prompt(strcat "\n" msg))(prompt "\n选择对象："))
  46.   (if filter-list (princ filter-list))

  48.   (setq loop t)
  49.   (setq oldent nil)
  50.   (setq result nil)
  51.   
  52.   (while loop
  53.     (setq gr (grread t 15 2)
  54.           code (car gr)
  55.           pt (cadr gr)
  56.     )
  57.    
  58.     (cond
  59.       ((= code 3)  ; 鼠标左键 - 确认选择
  60.        (if oldent
  61.          (progn
  62.            (setq result (list oldent pt))
  63.            (setq loop nil)
  64.          )
  65.          (progn
  66.            (setq result nil)
  67.            (setq loop nil)
  68.          )
  69.        )
  70.       )
  71.       
  72.       ((= code 5)  ; 鼠标移动 - 实时高亮
  73.        (redraw)  ; 清除所有临时图形
  74.       
  75.        ; 取消旧图元高亮
  76.        (if oldent
  77.          (progn
  78.            (redraw oldent 4)
  79.            (setq oldent nil)
  80.          )
  81.        )
  82.       
  83.        ; 尝试选择并高亮新图元
  84.        (if (and
  85.              (setq d (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox")))
  86.              (setq ptlst (list (jspt pt d d)
  87.                                (jspt pt (* -1 d) d)
  88.                                (jspt pt (* -1 d) (* -1 d))
  89.                                (jspt pt d (* -1 d))))
  90.              ; 使用解析后的filter-list作为ssget的过滤条件
  91.              (setq ss (ssget "_C" (car ptlst) (caddr ptlst) (if filter-list filter-list)))
  92.              (= (sslength ss) 1)
  93.              (setq ent (ssname ss 0))
  94.          )
  95.          (progn
  96.            (redraw ent 3)  ; 高亮新图元
  97.            (setq oldent ent)  ; 记录新图元
  98.          )
  99.        )
  100.       )
  101.       
  102.       ((or (= code 11) (= code 25))  ; 鼠标右键 - 退出
  103.        (setq result nil)
  104.        (setq loop nil)
  105.       )
  106.       (t)  ; 其他事件忽略
  107.     )
  108.   )
  109.   
  110.   ; 清理工作：取消所有高亮
  111.   (if oldent (redraw oldent 4))
  112.   (princ)
  113.   result  ; 返回选择结果
  114. )



网友答: 本帖最后由 yanshengjiang 于 2025-10-12 02:10 编辑



网友答: 谢谢分享，你辛苦了。

网友答: 我记得有一个剪切功能也是这样亮显，横2条中间竖一条交叉，点上下中间交叉段高亮显剪切。楼主那个图片填充研发一下看

网友答: 楼主最近比较高产

网友答:
pengbin 发表于 2025-10-12 12:05
我记得有一个剪切功能也是这样亮显，横2条中间竖一条交叉，点上下中间交叉段高亮显剪切。楼主那个图片填充 ...

哪个图片填充？估计我不会。

网友答: 感谢分享。  

网友答: 多谢分享！！！！！！
  • 上一篇：工具面板切换标签不闪屏
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025