开口 LINE 框选 圆角

ysq101

图片如下：

框选3条   或   4条LINE 线全角倒R角  （PS:  不会出现4条线以上的情况）

大师们给个思路好吗？？？

新手只会用纯LISP来写点简单的

另外请教如何求得   四条LINE的最大包围盒的四个点
这样我就可以自己写出第一个图的LISP程序来。。

先谢谢大家了。。

题外话：怎么这么久没见过NEWER版主了？？还有那个葛老去哪了？？好久都见过他啃黄瓜的头像了  {:soso_e100:}

ysq101

st788796 发表于 2014-2-23 22:42
1208的通用函数库可能有点问题，估计是反应器函数作怪，自己可以收集下"函数发布"编译，这样可控
做为爱好 ...

刚学会了用子函数了.....好难啊.....
谁知道LISP通用函数有BUG

很多像你这样的大神写的程序都含有LISP通能函数

又不能测试程序

有办法修复一下吗???

可以把有关反应器的部分先分离出来吗??

等我等新手有机会测试程序吧~~~~~感谢了...


PS:   有API   +  LISP 通用函数写程序真的快得多了....

ysq101

补充一下。。。图片最右下角的一条线是十字光标线。。。剪图剪多出来的。。

st788796

先完成fillet r 0算法再说别的
框选线，inters nil选项求两两交点，排除不在选取框内的交点，然后用fillet命令也可以，自己用数学方法计算后entmod entmake也可以

i3ku

这个别的论坛有发过的

ysq101

i3ku 发表于 2014-2-23 20:44
这个别的论坛有发过的

明经吗????在哪呢?

ysq101

st788796 发表于 2014-2-23 17:36
先完成fillet r 0算法再说别的
框选线，inters nil选项求两两交点，排除不在选取框内的交点，然后用fillet ...

谢谢你了.......

另外问一下:

为什么我加载了LISP通用函数CAD就崩溃呢??

准确地来说是打开CAD自带的VLISP编辑器就是崩溃

不能正常关闭CAD

只能结束进程才能关闭......

是什么原因呢??

我的环境是:  WINDOWS XP  SP3      
CAD 2004

st788796

1208的通用函数库可能有点问题，估计是反应器函数作怪，自己可以收集下"函数发布"编译，这样可控
做为爱好或者提高工作效率，xdrxapi+lisp lib绝对值得使用，如果另有想法就要修炼了

i3ku

借花献佛，感谢原作者
(princ "\n程序功能：批量倒圆角")
(princ "\n作者：英雄无敌")
(princ "\nQQ:280212043")
(princ "\n Email:280212043@qq.com")
(princ
  "\n选择距离的时候，要大于最大的缺口，但又必须小于两个不同集合之间的距离，不然会有问题。"
)
(princ "\n使用命令：fff.")
(defun c:fff (/ myerr olderr ss osm ort ped rad ss1 dis n en lst enl)
  (setvar "cmdecho" 0)
;;;****************************************************
  (princ "\n请保证所选对象都在当前视口内...")
  (defun myerr (msg)
    ;;************************************************
    ;;在这里写入错误处理函数
    (setq *error* olderr)
    (princ msg)
    (if        osm
      (setvar "osmode" osm)
    )
    (if        ort
      (setvar "orthomode" ort)
    )
    (command "undo" "E")
    ;;**********************

    (princ)
  )
  (setq olderr *error*)
  (setq *error* myerr)
  ;;初始化
  (setq ss (ssgetfirst))
  (command "undo" "BE")
  (setq osm (getvar "osmode"))
  (setq ort (getvar "orthomode"))
  (setq ped (getvar "peditaccept"))

  (setvar "osmode" 0)
  (setvar "orthomode" 0)
;;;****************************************************
  ;;在这里写入正常工作的函数
  (setq rad -1)
  (while (and
           (/= nil rad)
           (> 0 rad)
         )
    (princ "\n请输入倒角半径<")
    (princ (getvar "filletrad"))
    (setq rad (getreal ">:"))
  )
  (if rad
    (setvar "filletrad" rad)
  )

  (setq ss1 (ssget '((0 . "line,arc,LWPOLYLINE"))))
  (if ss1
    (setq dis (getdist "\n请输入一个合适的间距:"))
  )
  (if (and ss1 dis)
    (progn
      (setq n -1)
      (setq ss (ssadd))
      (repeat (sslength ss1)
        (setq en (ssname ss1 (setq n (1+ n))))
        (setq lst (entget en))
        (cond
          ((= "LINE" (cdr (assoc 0 lst)))
           (ssadd en ss)
          )
          ((= "ARC" (cdr (assoc 0 lst)))
           (entdel en)
          )
          ((= "LWPOLYLINE" (cdr (assoc 0 lst)))
           (setq enl (entlast))
           (command "explode" en)
           (while (setq enl (entnext enl))
             (setq lst (entget enl))
             (cond
               ((= "LINE" (cdr (assoc 0 lst)))
                (ssadd enl ss)
               )
               (t
                (entdel enl)
               )
             )
           )


          )
        )
      )

      (if (and ss (> (sslength ss) 0))
        (progn
          (setvar "peditaccept" 1)
          (setq enl (entlast))
          (command "pedit" "m" ss "" "j" "j" "e" dis "")
          (setq ss (ssadd))
          (while (setq enl (entnext enl))
            (ssadd enl ss)
          )
          (if (> (sslength ss) 0)
            (progn
              (setq n -1)
              (repeat (sslength ss)
                (hero_fillet (ssname ss (setq n (1+ n))))
              )
            )
          )
        )
      )
    )
  )
;;;****************************************************
  ;;结束
  (setvar "osmode" osm)
  (setvar "orthomode" ort)
  (command "undo" "E")
  (setvar "peditaccept" ped)
  (setq *error* olderr)
  (princ)
)
(defun getmidp (firp senp)
;;;取得两点的中点
  (list        (/ (+ (car firp) (car senp)) 2.0)
        (/ (+ (cadr firp) (cadr senp)) 2.0)
        0
  )
)
(defun hero_fillet (en / cl lst n p1 p2 p3 mp1 mp2 filrad)
  (setq filrad (getvar "filletrad"))
  (if (> filrad 0)
    (progn
      (setq lst (entget en))
      (setq cl (cdr (assoc 70 lst)))
      (setq lst (vl-remove-if '(lambda (x) (/= 10 (car x))) lst))
      (if (= 1 cl)
        (setq lst (append lst (list (car lst))))
      )
      (setq n 0)
      (repeat (- (length lst) 2)
        (setq p1 (cdr (nth n lst)))
        (setq p2 (cdr (nth (+ n 1) lst)))
        (setq p3 (cdr (nth (+ n 2) lst)))
        (setq mp1 (getmidp p1 p2)
              mp2 (getmidp p2 p3)
        )
        (if  (hero_canfillet p1 p2 p3  filrad)
                  

          (command "fillet" mp1 mp2)
        )
        (setq n (1+ n))
      )
      (if (vlax-curve-isclosed (vlax-ename->vla-object en))
        (progn
          (setq p1 (cdr (nth n lst)))
          (setq p2 (cdr (nth (+ n 1) lst)))
          (setq p3 (cdr (nth 1 lst)))
          (setq        mp1 (getmidp p1 p2)
                mp2 (getmidp p2 p3)
          )
          (if  (hero_canfillet p1 p2 p3 filrad)
                    

            (command "fillet" mp1 mp2)
          )
        )
      )
    )
  )
)
(defun hero_canfillet(p1 p2 p3 filrad)
  (setq ang1 (angle p1 p2))
  (setq ang2 (angle p2 p3))
  (setq ang (+ (- pi ang1) ang2))
  (if (> ang pi) (setq ang (- (*  2 pi) ang )))
  (setq ang (/ ang 2.0))
  (setq fl (abs (* (* filrad (cos ang)) 2)))
  (if (and
        (> (distance p1 p2) fl)
        (> (distance p2 p3) fl)
        (not (equal (abs (sin ang1)) (abs (sin ang2)) 0.001))
        )
    t
    nil
    )
  )

ysq101

i3ku 发表于 2014-2-24 09:46
借花献佛，感谢原作者
(princ "\n程序功能：批量倒圆角")
(princ "\n作者：英雄无敌")

这是什么工具箱啊？？？

77077

据我所知,你可以用PEDIT=>M     然后用 FILLET=>P

ysq101

77077 发表于 2014-2-24 11:59
据我所知,你可以用PEDIT=>M     然后用 FILLET=>P

哈哈。。。果然有道理。。。
这得少写多少代码啊。。。。

谢了啊