如何选择圆后，自动删除与圆相交的水平线
相交的非水平线和不相交的线均不删除
谢谢







网友答:
  2. (defun c:delhoriz (/ ent cir obj circle-data line-obj line-data pt1 pt2
  3.                         min-x max-x min-y max-y line-y
  4.                         circle-center circle-radius dist)
  5.   ; 设置系统变量
  6.   (setvar "osmode" 0)
  7.   (setvar "cmdecho" 0)
  8.   
  9.   ; 提示用户选择一个圆
  10.   (princ "\n请选择一个圆: ")
  11.   (setq ent (entsel)
  12.         cir (car ent)
  13.         obj (vlax-ename->vla-object cir))
  14.   
  15.   ; 检查选择的是否为圆
  16.   (if (/= (vla-get-objectname obj) "AcDbCircle")
  17.       (progn
  18.         (princ "\n选择的不是圆!")
  19.         (exit)
  20.       )
  21.   )
  22.   
  23.   ; 获取圆的参数
  24.   (setq circle-center (vla-get-center obj)
  25.         circle-radius (vla-get-radius obj))
  26.   
  27.   ; 提示操作信息
  28.   (princ "\n正在处理与圆相交的水平线...")
  29.   
  30.   ; 遍历所有直线
  31.   (setq line-obj (vla-get-activedocument (vlax-get-acad-object))
  32.         line-obj (vla-get-modelspace line-obj)
  33.         line-obj (vla-item line-obj 0))
  34.   
  35.   (vlax-for line-obj (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
  36.     ; 检查是否为直线
  37.     (if (= (vla-get-objectname line-obj) "AcDbLine")
  38.         (progn
  39.           ; 获取直线的两个端点
  40.           (setq pt1 (vla-get-startpoint line-obj)
  41.                 pt2 (vla-get-endpoint line-obj))
  42.          
  43.           ; 检查是否为水平线 (Y坐标相等)
  44.           (if (< (abs (- (vla-get-y pt1) (vla-get-y pt2))) 1e-6)
  45.               (progn
  46.                 ; 水平线的Y坐标
  47.                 (setq line-y (vla-get-y pt1))
  48.                
  49.                 ; 计算直线的X范围
  50.                 (setq min-x (min (vla-get-x pt1) (vla-get-x pt2))
  51.                       max-x (max (vla-get-x pt1) (vla-get-x pt2)))
  52.                
  53.                 ; 计算圆心到水平线的垂直距离
  54.                 (setq dist (abs (- line-y (vla-get-y circle-center))))
  55.                
  56.                 ; 检查距离是否小于等于圆半径 (可能相交)
  57.                 (if (<= dist circle-radius)
  58.                     (progn
  59.                       ; 计算圆与水平线交点的X坐标
  60.                       (setq x-intercept (sqrt (- (* circle-radius circle-radius) (* dist dist))))
  61.                      
  62.                       ; 检查交点是否在直线段上
  63.                       (if (or (and (>= (+ (vla-get-x circle-center) x-intercept) min-x)
  64.                                    (<= (+ (vla-get-x circle-center) x-intercept) max-x))
  65.                               (and (>= (- (vla-get-x circle-center) x-intercept) min-x)
  66.                                    (<= (- (vla-get-x circle-center) x-intercept) max-x)))
  67.                           (progn
  68.                             ; 删除相交的水平线
  69.                             (vla-delete line-obj)
  70.                             (princ "\n已删除一条相交的水平线")
  71.                           )
  72.                       )
  73.                   )
  74.               )
  75.           )
  76.         )
  77.     )
  78.   )
  79.   
  80.   ; 恢复系统变量
  81.   (setvar "cmdecho" 1)
  82.   (princ "\n操作完成!")
  83.   (princ)
  84. )



网友答:
czb203 发表于 2025-9-7 09:28

谢谢您的指导
下载来试说是程序有问题
我试着加了一个括号 )
但测试时提示
正在处理与圆相交的水平线...
Error: no function definition: VLA-GET-Y
好象是差函数
请您再看看
谢谢

网友答: 本帖最后由 llsheng_73 于 2025-9-7 15:05 编辑

  1. (vl-load-com)
  2. (defun tt(p0 r p1 p2 / a b c d)
  3.   (setq a(*(distance p1 p2)(distance p1 p2))
  4.         b(*(apply'+(mapcar '*(mapcar'- p2 p1)(mapcar'- p1 p0)))2)
  5.         c(-(*(distance p1 p0)(distance p1 p0))(* r r)))
  6.   (or(MINUSP(setq d(-(* b b)(* 4 a c))))
  7.      (vl-every(function(lambda(x)(or(MINUSP x)(< 1 x))))
  8.               (list(/(-(sqrt d) b)a 2)(/(+(sqrt d) b)a -2)))))
  9. (defun c:tt(/ s obj p0 r a b)
  10.   (if(or(PROMPT"\n\r请选择一个圆: ")
  11.         (setq s(ssget":E:S"'((0 . "circle")))))
  12.     (progn
  13.       (vlax-invoke-method(vlax-ename->vla-object(setq obj(ssname s 0)))'GetBoundingBox 'a 'b)
  14.       (setq obj(entget obj)
  15.             p0(cdr(assoc 10 obj))
  16.             r(cdr(assoc 40 obj))
  17.             s(ssget"C"(vlax-safearray->list a)(vlax-safearray->list b)'((0 . "line"))))
  18.       (vl-every(function(lambda(x / a b)
  19.                           (if(=(type(setq x(cadr x)))'ename)
  20.                             (progn(setq a(mapcar'+(vlax-curve-getstartpoint x)'(0 0))
  21.                                         b(vlax-curve-getendpoint x))
  22.                               (if(equal(cadr a)(cadr b)1e-8)
  23.                                 (or(tt p0 r a b)(entdel x)))))
  24.                           t))
  25.                (ssnamex s))
  26.       )
  27.     )
  28.   )


网友答:
llsheng_73 发表于 2025-9-7 15:00

谢谢 73 大师的热心指导
程序很好，瞬间完成任务
大师高风亮节，技术顶尖
衷心感谢

网友答:
ynhh 发表于 2025-9-7 17:20
谢谢 73 大师的热心指导
程序很好，瞬间完成任务
大师高风亮节，技术顶尖

感谢不能光口头上，要给明经币
  • 上一篇：亮显选择集
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025