那位高手把smartstar兄的 弯头程序给改一下

357785513

那位高手把smartstar兄的 弯头程序给改一下,弯头的内弯默认应该是管的三分之一大小,而他的程序内弯默认是管的是二分之一大小.不太理想,以下是smartstar兄的程序


(defun c:ddd (/   ip1 ip2 ip3 la  a   co  e   a1  d1  d2  d3  dn  p
       li  l1  l2  l3  l4  l5  l6  lt  i   m1  n1  m2  n2  m3
       n3  r   f   a   b   c   x   y   z
      )
  (setvar "cmdecho" 0)
  (setq a (ssget))
  (setq n (sslength a))
  (cond ((= n 6)
  (setq i 1)
  (setq pt0 (getpoint "请选择倒角方向点:"))
  (setq p (trans pt0 1 0))
  (setq d1 (dis (ssname a 0)))
  (setq a1 (ang (ssname a 0)))
  (setq m1 0
        n1 100
        m2 100
        n2 100
        m3 100
        n3 100
  )
  (repeat 5
    (sort i)
    (setq i (1+ i))
  )
  (setq l1 (ssname a m1))
  (setq l2 (ssname a n1))
  (setq l3 (ssname a m2))
  (setq l4 (ssname a n2))
  (setq l5 (ssname a m3))
  (setq l6 (ssname a n3))
  (setq la (cdr (assoc 8 (entget l1))))
  (setq co (cdr (assoc 62 (entget l1))))
  (setq lt (cdr (assoc 6 (entget l1))))
  (setq a (cdr (assoc 10 (entget l1))))
  (setq b (cdr (assoc 11 (entget l1))))
  (setq c (cdr (assoc 10 (entget l5))))
  (setq x (cdr (assoc 10 (entget l2))))
  (setq y (cdr (assoc 11 (entget l2))))
  (setq z (cdr (assoc 10 (entget l6))))
  (setq ip1 (pinter l1 l2))
  (setq ip2 (pinter l3 l4))
  (setq ip3 (pinter l5 l6))
  (setq
    d1 (abs (* (sin (- (angle a b) (angle a c))) (distance a c)))
  )
  (setq
    d2 (abs (* (sin (- (angle x y) (angle x z))) (distance x z)))
  )
  (if (<= d1 d2)
    (setq r1 (/ d1 2))
    (setq r1 (/ d2 2))
  )
  (setq
    r
     (getdist (strcat "\n请输入倒角半径【增大一倍输入"(rtos (* r1 2) 2)"】<"  (rtos r1 2)">:")
     )
  )
  (if (= r nil)
    (setq r r1)
  )
  (lu l1 ip1)
  (lu l2 ip1)
  (lu l3 ip2)
  (lu l4 ip2)
  (lu l5 ip3)
  (lu l6 ip3)
  (if (<= d1 d2)
    (progn
      (setq d3 (+ (/ d1 2) r))
      (setq f (+ d1 r))
    )
    (progn
      (setq d3 (+ (/ d2 2) r))
      (setq f (+ d2 r))
    )
  )
  (setvar "filletrad" r)
  (command "fillet" l1 l2)
  (setq j (entget (entlast)))
  (setvar "filletrad" d3)
  (command "fillet" l3 l4)
  (setvar "filletrad" f)
  (command "fillet" l5 l6)
  (setq k (entget (entlast)))
  (command "line"
    (trans (polar (cdr (assoc 10 j))
    (cdr (assoc 50 j))
    (cdr (assoc 40 j))
    )
    0
    1
    )
    (trans (polar (cdr (assoc 10 k))
    (cdr (assoc 50 k))
    (cdr (assoc 40 k))
    )
    0
    1
    )
    ""
  )
  (setq li (ssadd))
  (setq li (ssadd (entlast) li))
  (command "line"
    (trans (polar (cdr (assoc 10 j))
    (cdr (assoc 51 j))
    (cdr (assoc 40 j))
    )
    0
    1
    )
    (trans (polar (cdr (assoc 10 k))
    (cdr (assoc 51 k))
    (cdr (assoc 40 k))
    )
    0
    1
    )
    ""
  )
  (setq li (ssadd (entlast) li))
  (COMMAND "chprop" li "" "la" la "")
  (if (= co nil)
    (command "chprop" li "" "c" "bylayer" "")
    (command "chprop" li "" "c" co "")
  )
  (if (= lt nil)
    (command "chprop" li "" "lt" "bylayer" "")
    (command "chprop" li "" "lt" lt "")
  )
)
((= n 4)
  (setq i 1)
  (setq pt0 (getpoint "请选择倒角方向点:"))
  (setq p (trans pt0 1 0))
  (setq d1 (dis (ssname a 0)))
  (setq a1 (ang (ssname a 0)))
  (setq m1 0
        n1 100
        m2 100
        n2 100
  )
  (repeat 3
    (sort i)
    (setq i (1+ i))
  )
  (setq l1 (ssname a m1))
  (setq l2 (ssname a n1))
  (setq l3 (ssname a m2))
  (setq l4 (ssname a n2))
  (setq la (cdr (assoc 8 (entget l1))))
  (setq co (cdr (assoc 62 (entget l1))))
  (setq lt (cdr (assoc 6 (entget l1))))
  (setq a (cdr (assoc 10 (entget l1))))
  (setq b (cdr (assoc 11 (entget l1))))
  (setq c (cdr (assoc 10 (entget l3))))
  (setq x (cdr (assoc 10 (entget l2))))
  (setq y (cdr (assoc 11 (entget l2))))
  (setq z (cdr (assoc 10 (entget l4))))
  (setq ip1 (pinter l1 l2))
  (setq ip2 (pinter l3 l4))
  (setq
    d1 (abs (* (sin (- (angle a b) (angle a c))) (distance a c)))
  )
  (setq
    d2 (abs (* (sin (- (angle x y) (angle x z))) (distance x z)))
  )
  (if (<= d1 d2)
    (setq r1 (/ d1 2))
    (setq r1 (/ d2 2))
  )
  (setq
    r
     (getdist (strcat "\n请输入倒角半径【增大一倍输入"(rtos (* r1 2) 2)"】<"  (rtos r1 2)">:")
     )
  )
  (if (= r nil)
    (setq r r1)
  )
  (lu l1 ip1)
  (lu l2 ip1)
  (lu l3 ip2)
  (lu l4 ip2)
  (if (<= d1 d2)
    (setq f (+ d1 r))
    (setq f (+ d2 r))
  )
  (setvar "filletrad" r)
  (command "fillet" l1 l2)
  (setq j (entget (entlast)))
  (setvar "filletrad" f)
  (command "fillet" l3 l4)
  (setq k (entget (entlast)))
  (command "line"
    (trans (polar (cdr (assoc 10 j))
    (cdr (assoc 50 j))
    (cdr (assoc 40 j))
    )
    0
    1
    )
    (trans (polar (cdr (assoc 10 k))
    (cdr (assoc 50 k))
    (cdr (assoc 40 k))
    )
    0
    1
    )
    ""
  )
  (setq li (ssadd))
  (setq li (ssadd (entlast) li))
  (command "line"
    (trans (polar (cdr (assoc 10 j))
    (cdr (assoc 51 j))
    (cdr (assoc 40 j))
    )
    0
    1
    )
    (trans (polar (cdr (assoc 10 k))
    (cdr (assoc 51 k))
    (cdr (assoc 40 k))
    )
    0
    1
    )
    ""
  )
  (setq li (ssadd (entlast) li))
  (COMMAND "chprop" li "" "la" la "")
  (if (= co nil)
    (command "chprop" li "" "c" "bylayer" "")
    (command "chprop" li "" "c" co "")
  )
  (if (= lt nil)
    (command "chprop" li "" "lt" "bylayer" "")
    (command "chprop" li "" "lt" lt "")
  )
)
(t (princ "\n选择的线数目不对"))
  )
  (princ)
)
(defun sort(i / ai e de)
  (setq e (ssname a i))
  (setq ai (ang e))
  (setq de (dis e))
  (if (or (equal ai a1 0.1) (equal ai (- pi a1) 0.1))
      (if (< d1 de)
          (if (< m2 100)
              (if (< (dis (ssname a m2)) de)
                  (setq m3 i)
                  (progn (setq m3 m2)
                         (setq m2 i)
                  )
              )
              (setq m2 i)
          )
          (progn (setq d1 de)
                 (setq m3 m2)
                 (setq m2 m1)
                 (setq m1 i)
          )
      )
      (if (< n1 100)
          (if (< dn de)
              (if (< n2 100)
                  (if (< (dis (ssname a n2)) de)
                      (setq n3 i)
                      (progn (setq n3 n2)
                             (setq n2 i)
                      )
                  )
                  (setq n2 i)
              )
              (progn (setq dn de)
                     (setq n3 n2)
                     (setq n2 n1)
                     (setq n1 i)
              )
          )
          (progn (setq n1 i)
                 (setq dn de)
          )
      )
)
)

(defun dis(a / pa pb)
  (setq pa (cdr (assoc 10 (entget a))))
  (setq pb (cdr (assoc 11 (entget a))))
  (abs (* (sin (- (angle pa pb) (angle pa p))) (distance pa p)))
)
(defun pinter(l1 l2 / ip)
  (setq ip (inters (cdr (assoc 10 (entget l1))) (cdr (assoc 11 (entget l1))) (cdr (assoc 10 (entget l2))) (cdr (assoc 11 (entget l2))) nil))
)
(defun lu(l ip / j k pa pb ang ang1 ang2)
  (setq j (entget l))
  (setq pa (cdr (assoc 10 j)))
  (setq pb (cdr (assoc 11 j)))
  (setq ang1 (angle pa pb))
  (setq ang2 (angle p ip))
  (setq ang (abs (- ang1 ang2)))
  (if (or (< ang (/ pi 2)) (> ang (* pi 1.5)))
      (setq k (subst (cons 11 ip) (assoc 11 j) j))
      (setq k (subst (cons 10 ip) (assoc 10 j) j))
  )
  (entmod k)
)

(defun ang (a / pa pb)
  (setq pa (cdr (assoc 10 (entget a))))
  (setq pb (cdr (assoc 11 (entget a))))
  (rem (angle pa pb) pi)
)

357785513

可能由于代码太长,唯恐只有smartstar兄方可改之呀

waterchen

把这里 (if (<= d1 d2)     (setq r1 (/ d1 2))     (setq r1 (/ d2 2))   )改成 (if (<= d1 d2)     (setq r1 (/ d1 3))     (setq r1 (/ d2 3))   )就得了

357785513

唉,还真是哦,高人,可不可以不用  "请选择倒角方向点"这一项直接默认为内弯弯就行了,在何处改,不吝赐教,

357785513

惜惜惜惜惜惜惜
   waterchen smartstar还有其它高手都不在线,
故无人赐教

357785513

那位高手路过稍带看能不能改一下哦,

东北-水地暖-温

本图程序精度更高：

357785513

唉,真是高呀高不可及呀,是高

konoko

求助: 拿楼主提供的smartstar的程序改了一下,1/3弯头大小及提示.
发现新的问题,点选方向不能随便点. 见上图所示,在中间直线区域任意点都能生成弯头
在点1处不能. 求解决的办法