暮雨晨曦 发表于 2023-5-23 17:04

求助可以写一个类似CHA倒角命令,可以倒凹角(海棠角)




命令操作模式类似于CHA 倒切角命令
输入命令,提示:当前倒角距离 1 = 0.0000,距离 2 = 0.0000
选择第一条直线或距离【D】;如果选择D 指定距离1:输入数值(默认5)然后 指定距离2 (距离2默认与距离1数值一样也可输入数值 )
命令支持 矩形 多段线 直线等(与倒角命令适用对象一直就好)

暮雨晨曦 发表于 2023-5-24 17:48

我找了论坛的,改了改 但是还是达不到最优的效果(DEFUN C:HTJ (/ GETLINE VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG1 ANG2)
        (setq cm(getvar "cmdecho") os(getvar "osmode"))
        (setvar "cmdecho" 0)
        (DEFUN GETLINE (MSG / A1)
                (INITGET 1)
                (SETQ A1 (CAR (ENTSEL MSG)))
                (WHILE (/= (CDR (ASSOC 0 (ENTGET A1))) "LINE")
                        (PRINC "\n您选的不是线图元,请再选一次...")
                        (INITGET 1)
                        (SETQ A1 (CAR (ENTSEL MSG)))
                )
                A1
        )
        (if (= h1 nil)
                (progn (print "当前默认第一条倒角距离:5 第二条倒角距离:5")(print))
                (progn (print (strcat "当前第一条倒角距离:" (rtos h1) ";第二条倒角距离:" (rtos h2))) (print))
        )
        (if (= "s" (getstring "设置倒角距离<s> 空格跳过:"))
                (progn
                        (setq h1(getreal "\n请输入第一条倒角距离:"))
                        (setq h2(getreal "\n请输入第二条倒角距离:"))
                        (setq h3 1)
                )
                (if ( /= h3 1)
                        (setq h1 5 h2 5)
                )
        )
        (SETQ VLINE1 (GETLINE "\n请选取第一条线: "))
        (WHILE (OR (= VLINE2 nil) (EQUAL VLINE1 VLINE2))
                (IF (EQUAL VLINE1 VLINE2) (PRINC "\n线重复,请再选一次..."))
                (SETQ VLINE2 (GETLINE "\n请选取第二条线: "))
        )
        (SETQ DL1 (ENTGET VLINE1) DL2 (ENTGET VLINE2)
                PT1 (CDR (ASSOC 10 DL1)) PT2 (CDR (ASSOC 11 DL1))
                PT3 (CDR (ASSOC 10 DL2)) PT4 (CDR (ASSOC 11 DL2))
                PT5 (INTERS PT1 PT2 PT3 PT4 nil))
        (IF (/= PT5 nil) (PROGN
                       (SETQ PT2 (IF (< (DISTANCE PT5 PT1) (DISTANCE PT5 PT2)) PT2 PT1)
                       PT4 (IF (< (DISTANCE PT5 PT3) (DISTANCE PT5 PT4)) PT4 PT3)
                       ANG1 (ANGLE PT5 PT2) ANG2 (ANGLE PT5 PT4)
                        PT1 (POLAR PT5 ANG1 h1) PT3 (POLAR PT5 ANG2 h2)
                        PT5 (POLAR PT3 ANG1 h1))
                        (ENTDEL VLINE1) (ENTDEL VLINE2)
                        (COMMAND "PLINE" PT2 PT1 PT5 PT3 PT4 "")
                                                                       )
                (T (PRINC "\n两直线无交点!"))
        )
        (setvar "osmode" os)(print)
        (PRINC)
)

depgfdepgf 发表于 2023-5-25 07:12

(DEFUN C:HTJ (/ GETLINE VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG1 ANG2)
      (setq cm(getvar "cmdecho") os(getvar "osmode"))
      (setvar "cmdecho" 0)
      (if (= h1 nil)
                (progn (print "当前默认第一条倒角距离:5 第二条倒角距离:5")(print))
                (progn (print (strcat "当前第一条倒角距离:" (rtos h1) ";第二条倒角距离:" (rtos h2))) (print))
      )
      (if (= "s" (getstring "设置倒角距离<s> 空格跳过:"))
                (progn
                        (setq h1(getreal "\n请输入第一条倒角距离:"))
                        (setq h2(getreal "\n请输入第二条倒角距离:"))
                        (setq h3 1)
                )
                (if ( /= h3 1)
                        (setq h1 5 h2 5)
                )
      )               
                (while
      (DEFUN GETLINE (MSG / A1)
                (INITGET 1)
                (SETQ A1 (CAR (ENTSEL MSG)))
                (WHILE (/= (CDR (ASSOC 0 (ENTGET A1))) "LINE")
                        (PRINC "\n您选的不是线图元,请再选一次...")
                        (INITGET 1)
                        (SETQ A1 (CAR (ENTSEL MSG)))
                )
                A1
      )
      (SETQ VLINE1 (GETLINE "\n请选取第一条线: "))
      (SETQ VLINE2 (GETLINE "\n请选取第二条线: "))      
      (SETQ DL1 (ENTGET VLINE1) DL2 (ENTGET VLINE2)
                PT1 (CDR (ASSOC 10 DL1)) PT2 (CDR (ASSOC 11 DL1))
                PT3 (CDR (ASSOC 10 DL2)) PT4 (CDR (ASSOC 11 DL2))
                PT5 (INTERS PT1 PT2 PT3 PT4 nil))
      (IF (/= PT5 nil) (PROGN
                         (SETQ PT2 (IF (< (DISTANCE PT5 PT1) (DISTANCE PT5 PT2)) PT2 PT1)
                         PT4 (IF (< (DISTANCE PT5 PT3) (DISTANCE PT5 PT4)) PT4 PT3)
                         ANG1 (ANGLE PT5 PT2) ANG2 (ANGLE PT5 PT4)
                        PT1 (POLAR PT5 ANG1 h1) PT3 (POLAR PT5 ANG2 h2)
                        PT5 (POLAR PT3 ANG1 h1))
                        (ENTDEL VLINE1) (ENTDEL VLINE2)
                        (COMMAND "PLINE" PT2 PT1 PT5 PT3 PT4 "")
                                                                                                (COMMAND "EXPLODE" (entlast))
                                                               )
                (T (PRINC "\n两直线无交点!"))
      )                )
      (setvar "osmode" os)
      (PRINC)
)
可以循环了,但支持矩形 多段线就不会了,希望大佬出手下

andyding 发表于 2023-5-26 11:19

我是菜鸟,凑合用吧。
(DEFUN C:HTJ (/        GETLINE        VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6
              PT7 ANG1 ANG2 H3)
(setq        cm (getvar "cmdecho")
        os (getvar "osmode")
)
(if (= htj_h1 nil)
    (progn (print "当前默认第一条倒角距离:5 第二条倒角距离:5")
           (print)
    )
    (progn (print (strcat "当前第一条倒角距离:"
                          (rtos htj_h1)
                          ";第二条倒角距离:"
                          (rtos htj_h2)
                  )
           )
           (print)
    )
)
(if (= "s" (getstring "[<S>设置倒角距离/<空格>跳过]:"))
    (progn
      (setq htj_h1 (getreal "\n请输入第一条边倒角距离:"))
      (setq htj_h2 (getreal "\n请输入第二条边倒角距离:"))
    )
    (if        htj_h1 htj_h2
      (setq htj_h1 5
          htj_h2 5
      )
    )
)
(while
    (defun getline (msg / a1 po)
      (setvar "osmode" 512)
      (setq po (getpoint msg))
      (if (= po nil)
        (progn
          (princ "\n未选取对象,退出.")
          (setvar "osmode" os)
          (exit)
        )
        (progn
          (setq a1 (ssname (ssget po po) 0))
          (cond        ((= (cdr (assoc 0 (entget a1))) "LWPOLYLINE")
               (command "_.explode" A1)
               (setq a1 (ssname (ssget po po) 0))
                )
                ((= (cdr (assoc 0 (entget a1))) "LINE")
               (setq a1 a1)
                )
                ((/= (cdr (assoc 0 (entget a1))) "LINE")
               (PRINC "\n您选的不是线,请再选一次:")
               (setq po (getpoint msg))
               (setq a1 (ssname (ssget po po) 0))
                )
          )
        )
      )
    )
   (SETQ VLINE1 (GETLINE "\n请选取第一条线: "))
   (SETQ VLINE2 (GETLINE "\n请选取第二条线: "))
   (setvar "osmode" 0)
   (SETQ DL1 (ENTGET VLINE1)
           DL2 (ENTGET VLINE2)
           PT1 (CDR (ASSOC 10 DL1))
           PT2 (CDR (ASSOC 11 DL1))
           PT3 (CDR (ASSOC 10 DL2))
           PT4 (CDR (ASSOC 11 DL2))
           PT5 (INTERS PT1 PT2 PT3 PT4 nil)
   )
   (IF (/= PT5 nil)
       (PROGN
       (SETQ PT2(IF        (< (DISTANCE PT5 PT1) (DISTANCE PT5 PT2))
                      PT2
                      PT1
                  )
             PT4(IF        (< (DISTANCE PT5 PT3) (DISTANCE PT5 PT4))
                      PT4
                      PT3
                  )
             ANG1 (ANGLE PT5 PT2)
             ANG2 (ANGLE PT5 PT4)
             PT1(POLAR PT5 ANG1 htj_h1)
             PT3(POLAR PT5 ANG2 htj_h2)
             PT5(POLAR PT3 ANG1 htj_h1)
       )
       (ENTDEL VLINE1)
       (ENTDEL VLINE2)
       (COMMAND "PLINE" PT2 PT1 PT5 PT3 PT4 "")
       (COMMAND "EXPLODE" (entlast))
       )
       (T (PRINC "\n两直线无交点!"))
   )
)
(setvar "osmode" os)
(PRINC)
)

暮雨晨曦 发表于 2023-5-26 21:36

depgfdepgf 发表于 2023-5-25 07:12
(DEFUN C:HTJ (/ GETLINE VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG1 ANG2)
      (set ...

可以的基本满足需求,但就是选择线段是点选,第二是矩形会被炸开 能否解决一下呢 谢谢

下文没句号。 发表于 2023-5-28 12:43

同求,有大佬可以解决吗?

d1742647821 发表于 2023-5-29 00:10

太简单了,明天给你写个,现在太晚了睡了

暮雨晨曦 发表于 2023-5-29 21:18

d1742647821 发表于 2023-5-29 00:10
太简单了,明天给你写个,现在太晚了睡了

期待您的大作

菜鸟初来乍到 发表于 2023-5-29 22:41

期待有大佬出来搞一下

pizi158545086 发表于 2023-8-3 10:53

d1742647821 发表于 2023-5-29 00:10
太简单了,明天给你写个,现在太晚了睡了

大佬,有时间写下吗?
页: [1] 2
查看完整版本: 求助可以写一个类似CHA倒角命令,可以倒凹角(海棠角)