两点矩形 定宽矩形

sammy

非常实用的插件，小巧但很有效

qmotuo

感谢分享  楼主厉害

hd654

谢谢楼主分享

下文没句号。

很不错的，谢谢分享

sharon21

在画图过程中就想要这个效果，终于找到源码了，感谢楼主

迷失1786

谢谢楼主分享！

zmzk

正好有需要，学习学习

林小林子

谢谢楼主分享。改成鼠标控制位置会更好。

GDFGFGF

林小林子 发表于 2025-10-2 17:30
谢谢楼主分享。改成鼠标控制位置会更好。

;; 增强版偏移记忆命令 - 修复图层选项问题，增加多个偏移选项
(defun c:O ( / *error* cmd cmde dist sel multiple last-length)
  ; 错误处理函数
  (defun *error* (msg)
    (if cmd (setvar 'CMDECHO cmd))
    (if cmde (setvar 'CMDDIA cmde))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,*函数被取消*"))
      (princ (strcat "\n错误: " msg))
    )
    (princ)
  )
  
  ; 保存系统变量
  (setq cmd (getvar 'CMDECHO))
  (setq cmde (getvar 'CMDDIA))
  (setvar 'CMDECHO 0)
  (setvar 'CMDDIA 0)
  
  ; 从注册表读取矩形长度记忆值
  (setq last-length (get_line_length_memory))
  (if (and last-length (> last-length 0.0001)) ; 检查是否有有效的长度值
    (progn
      (princ (strcat "\n检测到最近线段长度 " (rtos last-length) "，已设为默认值"))
      (setq dist last-length)
    )
    (progn
      ; 如果没有长度值，从注册表读取偏移记忆值
      (setq dist (get_om_memory))
      (if (not dist)
        (setq dist 10.0)
      )
    )
  )
  
  ; 初始化多个偏移标志
  (setq multiple nil)
  
  ; 使用原生OFFSET命令的提示和选项
  (while (progn
           (initget 32 "Through Erase Layer Multiple Undo") ; 32=允许任意输入（包括点选）
           (setq sel (getdist (strcat "\n指定偏移距离或 [通过(T)/删除(E)/图层(L)/多个(M)/放弃(U)] <" (rtos dist) ">: ")))
           
           (cond
             ; 处理通过选项
             ((and (= (type sel) 'STR) (wcmatch (strcase sel) "THROUGH*,T*"))
              (setq multiple nil) ; 重置多个偏移标志
              (setvar 'CMDECHO 1)
              (command "_.OFFSET" "_Through")
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 处理删除选项
             ((and (= (type sel) 'STR) (wcmatch (strcase sel) "ERASE*,E*"))
              (setq multiple nil) ; 重置多个偏移标志
              (setvar 'CMDECHO 1)
              (command "_.OFFSET" "_Erase")
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 处理图层选项 - 修复图层切换问题
             ((and (= (type sel) 'STR) (wcmatch (strcase sel) "LAYER*,L*"))
              (setq multiple nil) ; 重置多个偏移标志
              (setvar 'CMDECHO 1)
              ; 使用AutoCAD原生的图层选项处理
              (command "_.OFFSET" "_Layer")
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 处理多个偏移选项
             ((and (= (type sel) 'STR) (wcmatch (strcase sel) "MULTIPLE*,M*"))
              (setq multiple t) ; 设置多个偏移标志
              (setvar 'CMDECHO 1)
              (command "_.OFFSET" "_Multiple")
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 处理放弃选项
             ((and (= (type sel) 'STR) (wcmatch (strcase sel) "UNDO*,U*"))
              (setq multiple nil) ; 重置多个偏移标志
              (setvar 'CMDECHO 1)
              (command "_.OFFSET" "_Undo")
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 处理距离输入（包括点选）
             ((= (type sel) 'REAL)
              (setq dist sel)
              ; 保存到注册表
              (set_om_memory dist)
              ; 清除线段长度记忆
              (clear_line_length_memory)
              (setvar 'CMDECHO 1)
              (if multiple
                (progn
                  (command "_.OFFSET" dist "_Multiple")
                  (setq multiple nil) ; 重置多个偏移标志
                )
                (command "_.OFFSET" dist)
              )
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              t ; 继续循环
             )
             ; 回车使用记忆值
             ((not sel)
              (setvar 'CMDECHO 1)
              (if multiple
                (progn
                  (command "_.OFFSET" dist "_Multiple")
                  (setq multiple nil) ; 重置多个偏移标志
                )
                (command "_.OFFSET" dist)
              )
              (while (> (getvar 'CMDACTIVE) 0)
                (command pause)
              )
              (setvar 'CMDECHO 0)
              ; 如果使用的是DD/D1传递的长度，不清除，可以继续使用
              ; 只有在输入新数值时才清除
              t ; 继续循环
             )
             ; 其他情况退出循环
             (t nil)
           )
         )
  )
  
  ; 恢复系统变量
  (setvar 'CMDECHO cmd)
  (setvar 'CMDDIA cmde)
  (princ)
)

;; 从注册表读取记忆的偏移值
(defun get_om_memory ( / reg-value)
  (setq reg-value (getenv "OM_OFFSET_MEMORY"))
  (if reg-value
    (atof reg-value)
    nil
  )
)

;; 将偏移值保存到注册表（永久记忆）
(defun set_om_memory (dist)
  (setenv "OM_OFFSET_MEMORY" (rtos dist 2 4))
  dist
)

;; 从注册表读取线段长度记忆值
(defun get_line_length_memory ( / reg-value)
  (setq reg-value (getenv "LINE_LENGTH_MEMORY"))
  (if reg-value
    (atof reg-value)
    nil
  )
)

;; 将线段长度保存到注册表
(defun set_line_length_memory (length)
  (setenv "LINE_LENGTH_MEMORY" (rtos length 2 4))
  length
)

;; 清除线段长度记忆
(defun clear_line_length_memory ()
  (setenv "LINE_LENGTH_MEMORY" "")
)

;; 定义全局变量来存储不同命令的默认宽度
(setq *DD-width* 10)  ; DD命令的默认宽度
(setq *D1-width* 10)  ; D1命令的默认宽度

(defun c:DD (/ p1 p2 p3 p4 base_angle angle_offset key pt gr s line-length *error* oldcmdecho oldosm olducs)
  ;;;;;;;;;;;定高定2点画矩形 - DD命令，默认宽度10
  
  ;; 错误处理函数
  (defun *error* (msg)
    (if oldcmdecho (setvar "cmdecho" oldcmdecho))
    (if oldosm (setvar "osmode" oldosm))
    (if olducs (command "._ucs" "_p")) ; 恢复之前的UCS
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\n错误: " msg))
    )
    (princ)
  )
  
  ;; 保存原始设置
  (setq oldcmdecho (getvar "cmdecho"))
  (setq oldosm (getvar "osmode"))
  (setq olducs T) ; 标记有UCS需要恢复
  
  (setvar "cmdecho" 0)
  
  ;; 切换到世界坐标系
  (command "._ucs" "_world")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  ;; 确保建筑图层存在
  (if (not (tblsearch "LAYER" "建筑"))
    (progn
      (command "._-layer" "_M" "建筑" "_C" "7" "建筑" "")
      (while (> (getvar "cmdactive") 0) (command ""))
    )
  )
  
  ;; 开始undo组
  (command "._undo" "_begin")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  (setq key T)
  (setq rdh *DD-width*)  ; 使用DD命令的默认宽度
  
  (initget "S ")
  (setq p1 (getpoint (strcat "\n矩形边起点,或,设置(S)<矩形宽度" (rtos rdh) ">:")))
  
  (while (and key (equal p1 "S"))
    (if (setq s (getdist (strcat "\n设置矩形宽度:<" (rtos rdh) ">")))
      (progn
        (setq rdh s)
        (setq *DD-width* s)  ; 更新全局变量
      )
    )
    (initget "S ")
    (setq p1 (getpoint (strcat "\n矩形边起点,或,设置(S)<矩形宽度" (rtos rdh) ">:")))
  )
  
  (if (and p1 (listp p1))
    (progn
      (setq p2 (getpoint p1 "矩形边终点："))
      (if p2
        (progn
          (setq base_angle (angle p1 p2))
          (setq line-length (distance p1 p2))  ; 计算两点之间的长度
         
          ; 进入预览状态
          (princ "\n移动鼠标确定矩形方向，点击确定...")
          (setq gr (grread t 15 0))
          (while (and gr
                     (/= (car gr) 3) ; 等待鼠标左键点击
                     (/= (car gr) 25)) ; 或右键点击
            (if (= (car gr) 5) ; 鼠标移动
              (progn
                (setq pt (cadr gr)) ; 获取当前鼠标位置
               
                ; 计算矩形方向（根据鼠标位置决定在哪一侧）
                (setq angle_offset
                      (if (> (sin (- (angle p1 pt) base_angle)) 0)
                        (* 0.5 pi)   ; 在基准线左侧
                        (* -0.5 pi)  ; 在基准线右侧
                      )
                )
               
                ; 计算矩形四个角点
                (setq p3 (polar p2 (+ base_angle angle_offset) rdh)
                      p4 (polar p1 (+ base_angle angle_offset) rdh)
                )
               
                ; 清除之前的预览
                (redraw)
               
                ; 绘制预览矩形
                (grdraw p1 p2 1 1) ; 基准边
                (grdraw p2 p3 2 1) ; 侧边1
                (grdraw p3 p4 2 1) ; 对边
                (grdraw p4 p1 2 1) ; 侧边2
              )
            )
            (setq gr (grread t 15 0))
          )
         
          ; 用户点击确认后，绘制实际矩形
          (if (= (car gr) 3) ; 鼠标左键点击
            (progn
              (redraw) ; 清除预览
              ;; 使用entmake创建多段线，设置图层和颜色
              (entmake (list '(0 . "LWPOLYLINE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbPolyline")
                             '(8 . "建筑")     ; 图层设置为"建筑"
                             '(62 . 256)      ; 颜色随层
                             '(90 . 4)        ; 4个顶点
                             '(70 . 1)        ; 闭合
                             (cons 10 p1)
                             (cons 10 p2)
                             (cons 10 p3)
                             (cons 10 p4)))
              ;; 将两点之间的长度保存到注册表，供O命令使用
              (set_line_length_memory line-length)
              (princ (strcat "\n已创建矩形，宽度: " (rtos rdh)))
              (princ (strcat "\n两点距离: " (rtos line-length)))
              (princ "\n现在可以使用 O 命令，将自动使用此长度作为偏移距离")
            )
          )
        )
      )
    )
  )
  
  ;; 结束undo组
  (command "._undo" "_end")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  ;; 恢复原始设置
  (setvar "cmdecho" oldcmdecho)
  (setvar "osmode" oldosm)
  (command "._ucs" "_p") ; 恢复之前的UCS
  (while (> (getvar "cmdactive") 0) (command ""))
  (setq olducs nil)
  (princ)
)

(defun c:D1 (/ p1 p2 p3 p4 base_angle angle_offset key pt gr s line-length *error* oldcmdecho oldosm olducs)
  ;;;;;;;;;;;定高定2点画矩形 - D1命令，默认宽度10
  
  ;; 错误处理函数
  (defun *error* (msg)
    (if oldcmdecho (setvar "cmdecho" oldcmdecho))
    (if oldosm (setvar "osmode" oldosm))
    (if olducs (command "._ucs" "_p")) ; 恢复之前的UCS
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\n错误: " msg))
    )
    (princ)
  )
  
  ;; 保存原始设置
  (setq oldcmdecho (getvar "cmdecho"))
  (setq oldosm (getvar "osmode"))
  (setq olducs T) ; 标记有UCS需要恢复
  
  (setvar "cmdecho" 0)
  
  ;; 切换到世界坐标系
  (command "._ucs" "_world")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  ;; 确保建筑图层存在
  (if (not (tblsearch "LAYER" "建筑"))
    (progn
      (command "._-layer" "_M" "建筑" "_C" "7" "建筑" "")
      (while (> (getvar "cmdactive") 0) (command ""))
    )
  )
  
  ;; 开始undo组
  (command "._undo" "_begin")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  (setq key T)
  (setq rdh *D1-width*)  ; 使用D1命令的默认宽度
  
  (initget "S ")
  (setq p1 (getpoint (strcat "\n矩形边起点,或,设置(S)<矩形宽度" (rtos rdh) ">:")))
  
  (while (and key (equal p1 "S"))
    (if (setq s (getdist (strcat "\n设置矩形宽度:<" (rtos rdh) ">")))
      (progn
        (setq rdh s)
        (setq *D1-width* s)  ; 更新全局变量
      )
    )
    (initget "S ")
    (setq p1 (getpoint (strcat "\n矩形边起点,或,设置(S)<矩形宽度" (rtos rdh) ">:")))
  )
  
  (if (and p1 (listp p1))
    (progn
      (setq p2 (getpoint p1 "矩形边终点："))
      (if p2
        (progn
          (setq base_angle (angle p1 p2))
          (setq line-length (distance p1 p2))  ; 计算两点之间的长度
         
          ; 进入预览状态
          (princ "\n移动鼠标确定矩形方向，点击确定...")
          (setq gr (grread t 15 0))
          (while (and gr
                     (/= (car gr) 3) ; 等待鼠标左键点击
                     (/= (car gr) 25)) ; 或右键点击
            (if (= (car gr) 5) ; 鼠标移动
              (progn
                (setq pt (cadr gr)) ; 获取当前鼠标位置
               
                ; 计算矩形方向（根据鼠标位置决定在哪一侧）
                (setq angle_offset
                      (if (> (sin (- (angle p1 pt) base_angle)) 0)
                        (* 0.5 pi)   ; 在基准线左侧
                        (* -0.5 pi)  ; 在基准线右侧
                      )
                )
               
                ; 计算矩形四个角点
                (setq p3 (polar p2 (+ base_angle angle_offset) rdh)
                      p4 (polar p1 (+ base_angle angle_offset) rdh)
                )
               
                ; 清除之前的预览
                (redraw)
               
                ; 绘制预览矩形
                (grdraw p1 p2 1 1) ; 基准边
                (grdraw p2 p3 2 1) ; 侧边1
                (grdraw p3 p4 2 1) ; 对边
                (grdraw p4 p1 2 1) ; 侧边2
              )
            )
            (setq gr (grread t 15 0))
          )
         
          ; 用户点击确认后，绘制实际矩形
          (if (= (car gr) 3) ; 鼠标左键点击
            (progn
              (redraw) ; 清除预览
              ;; 使用entmake创建多段线，设置图层和颜色
              (entmake (list '(0 . "LWPOLYLINE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbPolyline")
                             '(8 . "建筑")     ; 图层设置为"建筑"
                             '(62 . 256)      ; 颜色随层
                             '(90 . 4)        ; 4个顶点
                             '(70 . 1)        ; 闭合
                             (cons 10 p1)
                             (cons 10 p2)
                             (cons 10 p3)
                             (cons 10 p4)))
              ;; 将两点之间的长度保存到注册表，供O命令使用
              (set_line_length_memory line-length)
              (princ (strcat "\n已创建矩形，宽度: " (rtos rdh)))
              (princ (strcat "\n两点距离: " (rtos line-length)))
              (princ "\n现在可以使用 O 命令，将自动使用此长度作为偏移距离")
            )
          )
        )
      )
    )
  )
  
  ;; 结束undo组
  (command "._undo" "_end")
  (while (> (getvar "cmdactive") 0) (command ""))
  
  ;; 恢复原始设置
  (setvar "cmdecho" oldcmdecho)
  (setvar "osmode" oldosm)
  (command "._ucs" "_p") ; 恢复之前的UCS
  (while (> (getvar "cmdactive") 0) (command ""))
  (setq olducs nil)
  (princ)
)

(princ "\n偏移记忆命令已加载，输入 O 使用。支持通过(T)/删除(E)/图层(L)/多个(M)/放弃(U)选项")
(princ "\n矩形绘制命令已加载，输入 DD 或 D1 使用。")
(princ)