明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1538|回复: 0

[OpenDCL] 请高手帮忙修改下程序

[复制链接]
发表于 2013-3-28 20:11:41 | 显示全部楼层 |阅读模式
这是一个由Zm184几年前编写的一个改进过的半径为0倒圆角的程序,可实线框选条件下的相互剪切,非常好用,用了几年了,感觉美中不足的是当二条线或多条线均为多义线时,功能就实效了,不能倒角了,请高手帮忙修改下,谢谢了!
;;功能:对系统提供的 圆角 命令的改进        
;;日期:zml84 于 2007-08-04 17:00           
(defun C:SSS (/             *ERROR* *MYERR* CMD_OLD OS_OLD  *OLDERR*
             TEST0   TEST    TMP     TMP2    INT     PT1     PT2
             SS             A             B
            )
    (princ "\n")
    ;;============================
    (defun *MYERR* (MSG)
        (setvar "CMDECHO" CMD_OLD)
        (setvar "OSMODE" OS_OLD)
        (setq *ERROR* *OLDERR*)
        (if (= MSG "")
            (princ (strcat "\n>>>" MSG))
            (princ "\n")
        )
        (princ)
    )
    (setq *OLDERR* *ERROR*
          *ERROR*  *MYERR*
          OS_OLD   (getvar "OSMODE")
          CMD_OLD  (getvar "CMDECHO")
    )
    ;;==============================
    ;;1、系统变量设置
    (setvar "OSMODE" 0)
    (setvar "CMDECHO" 0)
    ;;显示选项当前值
    (princ
        (strcat
            "\n当前设置: 模式 = "
            (nth (getvar "TRIMMODE") '("不修剪" "修剪"))
            ",半径 = "
            (rtos (getvar "FILLETRAD") 2 4)
        )
    )
    ;;2、循环连续执行
    (setq TEST0 t)
    (while TEST0
        ;;初始化
        (setq A        NIL
              B        NIL
        )
        ;;2.1、选择对象1
        (princ "\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: ")
        (setq TEST t)
        (while TEST
            (setq TMP (grread t 4 2))
            (cond
                ;;按下键盘键
                ((= (car TMP) 2)
                 (setq INT (cadr TMP))
                 (cond
                     ;;回车或者空格键,则退出
                     ((or (= INT 13)
                          (= INT 32)
                      )
                      (setq TEST NIL
                            TEST0 NIL
                      )
                     )
                     ;;P选项
                     ((or (= (ascii "P") INT)
                          (= (ascii "p") INT)
                      )
                      (if (and (setq SS (entsel " >>选择二维多段线: "))
                               (= (cdr (assoc 0 (entget (car SS))))
                                  "LWPOLYLINE"
                               )
                          )
                          (command "_.fillet" "P" SS)
                      )
                     )
                     ;;R选项
                     ((or (= (ascii "R") INT)
                          (= (ascii "r") INT)
                      )
                      (princ (strcat "\n>>指定圆角半径 <"
                                     (rtos (getvar "FILLETRAD") 2 2)
                                     ">: "
                             )
                      )
                      (if (setq TMP2 (getdist))
                          (setvar "FILLETRAD" TMP2)
                      )
                     )
                     ;;T选项
                     ((or (= (ascii "T") INT)
                          (= (ascii "t") INT)
                      )
                      (initget "T N")
                      (setq TMP2
                               (getkword
                                   (strcat
                                       "\n>>输入修剪模式选项 [修剪(T)/不修剪(N)] <"
                                       (nth (getvar "TRIMMODE")
                                            '("不修剪" "修剪")
                                       )
                                       ">: "
                                   )
                               )
                      )
                      (if (= TMP2 "T")
                          (setvar "TRIMMODE" 1)
                          (if (= TMP2 "N")
                              (setvar "TRIMMODE" 0)
                          )
                      )
                     )
                 )
                 (princ "\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: ")
                )
                ;;击鼠标右键
                ((= (car TMP) 12)
                 (setq TEST NIL
                       TEST0 NIL
                 )
                )
                ;;击左键
                ((= (car TMP) 3)
                 (setq PT1 (cadr TMP))
                 (if (setq SS (ssget PT1))
                     (setq A        (list (ssname SS 0) PT1)
                           TEST        NIL
                     )
                     (if (and
                             (setq PT2 (getcorner PT1 " >>>第二点:"))
                             (setq SS (ssget "c" PT1 PT2))
                         )
                         (progn
                             (setq A        (list (ssname SS 0) (MID PT1 PT2))
                                   TEST        NIL
                             )
                             (if (>= (sslength SS) 2)
                                 (setq B (list (ssname SS 1)
                                               (MID PT1 PT2)
                                         )
                                 )
                             )
                         )
                         (princ
                             "\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: "
                         )
                     )
                 )
                )
            ) ;_ 结束 cond
        ) ;_ 结束 while
        (if (and A
                 (not (redraw (car A) 3))
                 (= B NIL)
            )
            (progn
                ;;2.2、选择对象2
                (princ "\n选择对象:")
                (setq TEST t)
                (while TEST
                    (setq TMP (grread t 4 2))
                    ;;(if (setq PT1 (getpoint "\n选择对象:"))
                    (cond
                        ;;击左键
                        ((= (car TMP) 3)
                         (setq PT1 (cadr TMP))
                         (if (setq SS (ssget PT1))
                             (setq B        (list (ssname SS 0) PT1)
                                   TEST        NIL
                             )
                             (if (and
                                     (setq
                                         PT2 (getcorner        PT1
                                                        " >>>第二点:"
                                             )
                                     )
                                     (setq SS (ssget "c" PT1 PT2))
                                 )
                                 (setq B    (list (ssname SS 0)
                                                  (MID PT1 PT2)
                                            )
                                       TEST NIL
                                 )
                                 (princ "\n选择对象:")
                             )
                         )
                        )
                        ;;击右键
                        ((= (car TMP) 12)
                         (setq TEST NIL)
                        )
                    ) ;_结束 cond
                )
            )
        ) ;_结束 if
        ;;圆角操作
        (if (and A B)
            (command "_.fillet" A B)
        )
        (if A
            (redraw (car A) 4)
        )
    )
    ;;3、恢复系统变量设置

    ;;============
    (*ERROR* "完美退出。谢谢使用。")
    ;;============
    (princ)
) ;_结束 defun
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-19 03:50 , Processed in 0.158185 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表