既可以框选倒角，也可以点选倒角LSP，希望大师们完善下

XDSoft

q3_2006 发表于 2013-6-24 09:20
XD:nts:IsInPnts没找到，不过我更新了API，2004版，还是一样呀，第一段什么反应也没有，12楼，只是把交 ...

就在“函数发布”和LISP论坛首页上。

--@-----

不行哦  红色代表框的部位，要一根一根的框。上面不行哦  红色代表框的部位，要一根一根的框。上面框的部位不同下面倒角的结果也不一样的，框的那部分线是保留的，

--@-----

不行哦  红色代表框的部位，要一根一根的框。上面框的部位不同下面倒角的结果也不一样的，框的那部分线是保留的，

--@-----

倒角既可以一根一根的点选，也可以一根一根的框选（对直线多段线都行）

eachy

我写的是框选删除部分，不能点选

--@-----

那不行的，因为有时候是重线，比如，轴线上面还压着一根线的，或者两根线本来就很远，中间有隔着几根线的，所以点选跟框选结合，是比较完美的，如果实在不好实现这个功能，就不研究了，也就是能提高一点画图的时间,呵呵

eachy

程序仅是提供一个思路，非专业人士写这些相对专业应用多数时候考虑不了那麽全面

--@-----

=================

--@-----

=====================================================================

牢固

ssnamex函数可以在这里派上大用场！

牢固

;;自由选择倒角、圆角 By Gu_xl 2013.06.24

游客，本帖隐藏的内容需要积分高于 20 才可浏览，您当前积分为 0

--@-----

牢固 发表于 2013-6-24 15:01
;;自由选择倒角、圆角 By Gu_xl 2013.06.24
**** 本内容被作者隐藏 ****

上面的代码多段线不能倒角的   大侠

--@-----

本命令三个难度要求：1是多段线，直线都能倒角  2是框选点选都可以（框选支持1跟1跟的框选）3是倒角的过程是框选或者点选的部分保留， 另一端头自动裁剪

hmillf

记得YAD做过一个！ ！ 不过好像还不是很好用。

;也发一个全功能的框选圆角程序
;;对十字交叉的线可感知圆角方向
;;部分代码参考了网上的程序
(defun c:yad_fillet(/ yad-dxf yad-entsel yad-movetotop yad-interpt goto_fillet oldpedit oldos acaddoc mspace trm p1 p2 prom lprom r boxlen ss l_bak l_pt ent i)
  (defun yad-dxf(en val) (cdr (assoc val (entget en))))
  (defun yad-entsel(msg filter / ext ent pt s)
    (while (not ext)
      (setq ent (entsel msg))
      (cond
        ((= (getvar "errno") 52) (setq ext T) (setvar "errno" 0) nil)
        ((and ent (setq s (ssget "_c" (polar (setq pt (cadr ent)) (* pi 1.25) boxlen) (polar pt (/ pi 4) boxlen) filter)) (setq ext T)) (list (ssname s 0) pt))
        (T (prompt "\n圆角需要直线、圆弧、圆或多段线！"))
      )
    )
  )
  (defun yad-movetotop(l_ent / extdic tbl)
    (setq l_ent (mapcar 'vlax-ename->vla-object l_ent))
    (setq extdic (vla-getextensiondictionary mspace))
    (if (vl-catch-all-error-p (setq tbl (vl-catch-all-apply 'vla-item (list extdic "acad_sortents"))))
      (setq tbl (vla-addobject extdic "acad_sortents" "acdbsortentstable"))
    )
    (vlax-invoke tbl "MoveToTop" l_ent)
  )
  (defun yad-interpt(obj s / n ent ipt pt l_p)
    (setq obj (vlax-ename->vla-object obj) n -1)
    (repeat (sslength s)
      (setq ent (vlax-ename->vla-object (ssname s (setq n (1+ n)))) ipt (vlax-variant-value (vla-intersectwith obj ent 0)))
      (if (and (> (vlax-safearray-get-u-bound ipt 1) 0) (setq ipt (vlax-safearray->list ipt)))
        (while (> (length ipt) 0)
          (setq pt (list (car ipt) (cadr ipt) (caddr ipt)) ipt (cdddr ipt))
          (if (not (vl-member-if '(lambda(e) (equal e pt boxlen)) l_p)) (setq l_p (cons pt l_p)))
        )
      )
    )
    (vla-delete obj)
    l_p
  )
  (defun goto_fillet(p1 p2 / ent1 ent2 wid ent2ispl s oldent newent)
    (setq ent1 (car p1))
    (if (not p2) (redraw ent1 3))
    (if (or p2 (setq p2 (yad-entsel "\n选择第二个对象：" '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))))
      (if (and (setq ent2 (car p2)) (member "LWPOLYLINE" (mapcar '(lambda(e) (yad-dxf e 0)) (list ent1 ent2))))
        (progn
          (redraw ent1 4)
          (if (= (yad-dxf ent2 0) "LWPOLYLINE")
            (setq ent1 p2 p2 (cadr p1) ent2 (car p1) p1 (cadr ent1) ent1 (car ent1))
            (setq p1 (cadr p1) p2 (cadr p2))
          )
          (setq wid (yad-dxf ent1 40) ent2ispl (= (yad-dxf ent2 0) "LWPOLYLINE"))
          (if (= trm 0)
            (progn
              (vla-copy (vlax-ename->vla-object ent1))
              (if (and ent2ispl (not (equal ent1 ent2))) (vla-copy (vlax-ename->vla-object ent2)))
              (yad-movetotop (if (equal ent1 ent2) (list ent1) (list ent1 ent2)))
            )
            (vl-cmdf "_.undo" "_m")
          )
          (setvar "qaflags" 1)
          (if ent2ispl (vl-cmdf "_.explode" ent1 ent2 "") (vl-cmdf "_.explode" ent1 ""))
          (setq s (ssget "_p") oldent (entlast))
          (setvar "qaflags" 0)
          (vl-catch-all-apply 'vl-cmdf (list "_.fillet" (setq ent1 (nentselp p1)) (setq ent2 (nentselp p2))))
          (cond
            ((= trm 0))
            ((and (equal (setq newent (entlast)) oldent) (/= (getvar "filletrad") 0)) (vl-cmdf "_.undo" "_b"))
            (T (vl-catch-all-apply 'vl-cmdf (append (list "_.pedit" (car ent1) "_j")
                                                    (if (equal newent oldent) nil (list newent))
                                                    (if (= (yad-dxf (setq ent2 (car ent2)) 0) "CIRCLE") nil (list ent2))
                                                    (list s "" "_w" wid "")))
            )
          )
          (vl-cmdf "_.erase" s "")
        )
        (vl-catch-all-apply 'vl-cmdf (list "_.fillet" p1 p2))
      )
      (redraw ent1 4)
    )
  )
  (vl-load-com)
  (setq oldpedit (getvar "peditaccept") oldos (getvar "osmode")
        mspace (vla-get-modelspace (setq acaddoc (vla-get-activedocument (vlax-get-acad-object))))
  )
  (setvar "peditaccept" 1)
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setvar "errno" 0)
  (vl-cmdf "_.undo" "_c" "_n" "_.undo" "")
  (while (/= (getvar "errno") 52)
    (princ "\n当前设置：模式 = ")
    (princ (if (= (setq trm (getvar "trimmode")) 1) "修剪" "不修剪"))
    (princ "，半径 = ")
    (princ (getvar "filletrad"))
    (initget (if (= trm 1) "U N" "U T"))
    (setq p1 (entsel (strcat "\n" (setq prom (strcat "选择对象或指定圆角半径或[放弃(U)/" (if (= trm 1) "不修剪对象(N)" "修剪对象(T)")"]：")))))
    (princ "\n")
    (setq lprom (getvar "lastprompt") r (substr lprom (1+ (vl-string-mismatch prom lprom)))
          boxlen (abs (/ (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize")) (sin (/ pi 4))))
    )
    (if (numberp (setq r (read r)))
      (setvar "filletrad" (abs r))
      (cond
        ((= p1 "U") (vl-cmdf "_.u"))
        ((= p1 "T") (setvar "trimmode" 1))
        ((= p1 "N") (setvar "trimmode" 0))
        ((and (not p1) (/= (getvar "errno") 52) (setq p2 (getcorner (setq p1 (cadr (grread T 6 2))) "\n指定对角点：")))
          (vla-startundomark acaddoc)
          (setq ss nil l_bak nil l_pt nil)
          (cond
            ((and (setq ss (ssget "_f" (list p1 p2) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
                  (vla-addline mspace (vlax-3d-point p1) (vlax-3d-point p2))
                  (setq l_bak (list ss (setq l_pt (yad-interpt (entlast) ss))))
                  (> (sslength ss) 1) (> (length l_pt) 1)
             )
            )
            ((and (setq ss (ssget "_f" (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1)) p1) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
                  (vl-cmdf "_.rectang" "_f" 0 p1 p2)
                  (setq l_pt (yad-interpt (entlast) ss))
             )
            )
          )
          (if (and l_bak (or (< (length l_pt) 2) (and (= (sslength ss) 1) (> (length (cadr l_bak)) 1)))) (setq ss (car l_bak) l_pt (cadr l_bak)))
          (cond
            ((not ss)
              (princ "\n没有交叉框选到直线、圆弧、圆、椭圆、多段线或样条曲线！")
            )
            ((or (= (sslength ss) 1) (= (length l_pt) 1))
              (goto_fillet (list (setq ent (ssname ss 0)) (car l_pt)) (if (and (= (yad-dxf ent 0) "LWPOLYLINE") (> (length l_pt) 1)) (list ent (cadr l_pt)) nil))
            )
            (T
              (setq p1 (nentselp (car l_pt)) l_pt (cdr l_pt) i -1)
              (while (and (setq p2 (nth (setq i (1+ i)) l_pt)) (setq p2 (nentselp p2)) (equal (car p2) (car p1))))
              (goto_fillet p1 p2)
            )
          )
          (vla-endundomark acaddoc)
        )
        ((and p1 (= (type (setq ent (car p1))) 'ename))
          (vla-startundomark acaddoc)
          (if (wcmatch (yad-dxf ent 0) "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")
            (goto_fillet p1 nil)
            (princ "\n圆角需要直线、圆弧、圆、椭圆、多段线或样条曲线！")
          )
          (vla-endundomark acaddoc)
        )
      )
    )
  )
  (setvar "peditaccept" oldpedit)
  (setvar "osmode" oldos)
  (princ)
)
(princ "\n框选圆角命令：yad_fillet")
(princ)

牢固

--@----- 发表于 2013-6-25 13:27
本命令三个难度要求：1是多段线，直线都能倒角  2是框选点选都可以（框选支持1跟1跟的框选）3是倒角的过程 ...

不能什么要求都混杂在一块，程序如何去判断？比如多段线是要自身圆角和多段线端线与直线圆角，判断的依据什什么呢？没有明确的作业标准，程序如何定制？