快速构造线绘制

haisensy

一个拉线快速绘制构造线的小功能，没其他了。快捷键FV，  一键清理构造线FVCLEAN

pengbin

挺好用的========试着优化了一下



(defun c:FV (/ old_osmode old_cmdecho pt1 pt2 lineA line_angle ss i ent intersections found)
  (vl-load-com)
  (setq old_osmode (getvar "osmode") old_cmdecho (getvar "cmdecho"))
  (setvar "osmode" 0) (setvar "cmdecho" 0)

  (setq pt1 (getpoint "\n请指定直线的起点: "))
  (if (not pt1) (progn (princ "\n操作已取消。") (exit)))

  (setq pt2 (getpoint pt1 "\n请指定直线的终点: "))
  (if (not pt2) (progn (princ "\n操作已取消。") (exit)))

  ; 绘制临时直线A
  (setq lineA (entmakex (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2))))
  (setq line_angle (get_line_angle pt1 pt2))
  (princ (strcat "\n线A的角度: " (rtos line_angle 2 2) " 度"))

  (setq construction_type (get_construction_type line_angle))
  (princ (strcat "\n将绘制 " construction_type " 构造线"))
  (princ "\n正在检查与其他线的交叉点...")

  (setq ss (ssget "X" '((0 . "LINE,LWPOLYLINE,POLYLINE"))))
  (create_construction_layer)
  (setq found nil)

  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (if (not (equal ent lineA))
          (progn
            (setq intersections (get_intersections lineA ent))
            (if intersections
              (progn
                (princ (strcat "\n找到交叉点数量: " (itoa (length intersections))))
                (setq found T)
                (draw_construction_lines intersections construction_type)
              )
            )
          )
        )
        (setq i (1+ i))
      )
    )
    (princ "\n图中没有其他直线或多段线。")
  )

  ; 删除临时直线A
  (if lineA (entdel lineA))
  (if (not found)
    (princ "\n没有找到交叉点。")
    (princ "\n构造线绘制完成，原始线A已删除。")
  )

  ; 恢复系统变量
  (setvar "osmode" old_osmode) (setvar "cmdecho" old_cmdecho)
  (princ)
)

; 计算直线角度（度，0-360范围）
(defun get_line_angle (pt1 pt2 / dx dy angle_rad angle_deg)
  (setq dx (- (car pt2) (car pt1)) dy (- (cadr pt2) (cadr pt1)))
  (setq angle_rad (atan dy dx) angle_deg (* angle_rad (/ 180.0 pi)))
  (if (< angle_deg 0) (setq angle_deg (+ angle_deg 360.0)))
  angle_deg
)

; 根据角度判断构造线类型（垂直/水平）
(defun get_construction_type (angle)
  (setq normalized_angle (rem angle 180.0))
  (if (< normalized_angle 0) (setq normalized_angle (+ normalized_angle 180.0)))
  (cond
    ((or (<= normalized_angle 45) (>= normalized_angle 135)) "垂直")
    ((and (> normalized_angle 45) (< normalized_angle 135)) "水平")
    (T "水平和垂直")
  )
)

; 创建构造线图层（CONSTRUCTION，红色虚线）
(defun create_construction_layer ()
  (setq layer "CONSTRUCTION")
  (if (not (tblsearch "LAYER" layer))
    (command "_.-LAYER" "_M" layer "_C" "1" "" "_L" "DASHED" "" "")
  )
)

; 获取两实体交叉点（支持LINE/LWPOLYLINE/POLYLINE）
(defun get_intersections (ent1 ent2 / obj1 obj2 points result)
  (setq obj1 (vlax-ename->vla-object ent1) obj2 (vlax-ename->vla-object ent2))
  (if (and obj1 obj2)
    (progn
      (setq points (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) result '())
      (if points
        (while (>= (length points) 3)
          (setq result (cons (list (car points) (cadr points) (caddr points)) result))
          (setq points (cdddr points))
        )
      )
    )
  )
  (reverse result)
)

; 绘制构造线（指定交叉点+类型，赋值图层/颜色）
(defun draw_construction_lines (intersections construction_type / point lastEnt)
  (foreach point intersections
    (cond
      ((= construction_type "垂直")
       (command "_.XLINE" "_V" point "")
       (setq lastEnt (entlast))
       (if lastEnt (progn
         (vla-put-layer (vlax-ename->vla-object lastEnt) "CONSTRUCTION")
         (vla-put-color (vlax-ename->vla-object lastEnt) 1)
       ))
      )
      ((= construction_type "水平")
       (command "_.XLINE" "_H" point "")
       (setq lastEnt (entlast))
       (if lastEnt (progn
         (vla-put-layer (vlax-ename->vla-object lastEnt) "CONSTRUCTION")
         (vla-put-color (vlax-ename->vla-object lastEnt) 1)
       ))
      )
      (T
       ; 绘制水平+垂直构造线
       (command "_.XLINE" "_H" point "")
       (setq lastEnt (entlast))
       (if lastEnt (progn
         (vla-put-layer (vlax-ename->vla-object lastEnt) "CONSTRUCTION")
         (vla-put-color (vlax-ename->vla-object lastEnt) 1)
       ))
       (command "_.XLINE" "_V" point "")
       (setq lastEnt (entlast))
       (if lastEnt (progn
         (vla-put-layer (vlax-ename->vla-object lastEnt) "CONSTRUCTION")
         (vla-put-color (vlax-ename->vla-object lastEnt) 1)
       ))
      )
    )
  )
  (princ (strcat "\n在 " (itoa (length intersections)) " 个交叉点处绘制了" construction_type "构造线。"))
)

; 帮助命令（FVHELP）
(defun c:FVHELP ()
  (princ "\n=== FV 命令使用说明 ===")
  (princ "\n功能: 绘制直线并自动在交叉点创建构造线")
  (princ "\n使用: 1.输入FV 2.指定直线起点 3.指定直线终点")
  (princ "\n逻辑: 水平基准线→垂直构造线；垂直基准线→水平构造线")
  (princ "\n辅助命令: FVCLEAN（清理构造线）、FVDEBUG（调试交叉点）")
  (princ "\n========================")
  (princ)
)

; 清理命令（FFV）
(defun c:fvqc ()
  (setq ss (ssget "X" '((8 . "CONSTRUCTION"))))
  (if ss
    (progn (command "_.ERASE" ss "") (princ (strcat "\n已删除 " (itoa (sslength ss)) " 个构造线对象。")))
    (princ "\n没有找到构造线对象。")
  )
  (princ)
)

; 调试命令（FFVV）
(defun c:FFVV (/ pt1 pt2 lineA line_angle construction_type ss i ent intersections objType)
  (vl-load-com)
  (setq pt1 (getpoint "\n请指定直线的起点: "))
  (if (not pt1) (exit))
  (setq pt2 (getpoint pt1 "\n请指定直线的终点: "))
  (if (not pt2) (exit))

  (setq lineA (entmakex (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2))))
  (setq line_angle (get_line_angle pt1 pt2))
  (princ (strcat "\n线A的角度: " (rtos line_angle 2 2) " 度"))
  (setq construction_type (get_construction_type line_angle))
  (princ (strcat "\n将绘制 " construction_type " 构造线"))

  (setq ss (ssget "X" '((0 . "LINE,LWPOLYLINE,POLYLINE"))))
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i) objType (cdr (assoc 0 (entget ent))))
        (if (not (equal ent lineA))
          (progn
            (setq intersections (get_intersections lineA ent))
            (princ (strcat "\n" objType " " (itoa i) ": "))
            (if intersections
              (progn
                (princ (strcat "找到 " (itoa (length intersections)) " 个交叉点"))
                (foreach pt intersections
                  (princ (strcat "\n  点: " (rtos (car pt) 2 2) "," (rtos (cadr pt) 2 2)))
                )
              )
              (princ "没有交叉点")
            )
          )
        )
        (setq i (1+ i))
      )
    )
    (princ "\n图中没有其他直线或多段线。")
  )

  (if lineA (entdel lineA))
  (princ)
)

; 加载提示
(princ "\nFV 命令已加载。输入 FV 开始使用，FFV 清理构造线，FFVV调试交叉点。")
(princ)

jierc

jierc 发表于 2025-10-28 15:29
发现个bug,你和楼主的都有，就是当对象是矩形框时，画了构造线后用FFV删除会把构造线和矩形框一起删了

增加说明下，是当矩形框在构造线图层CONSTRUCTION时会出现这个情况

jierc

pengbin 发表于 2025-10-27 23:32
挺好用的========试着优化了一下

发现个bug,你和楼主的都有，就是当对象是矩形框时，画了构造线后用FFV删除会把构造线和矩形框一起删了

jierc

功能挺好，就是不知道这个用在哪些场景

qifeifei

jierc 发表于 2025-10-27 11:51
功能挺好，就是不知道这个用在哪些场景

演示效果 诺

23410997

功能挺好，感谢分享

zmzk

挺好玩，适合快速 画辅助线，要是变成  固定长度的直线    就好了

qifeifei

qifeifei 发表于 2025-10-27 11:59
演示效果 诺

那个是拆单的事情 我们不必操心

浅予

jierc 发表于 2025-10-27 11:51
功能挺好，就是不知道这个用在哪些场景

复核兄弟们东西的时候好用