bloodtempt 发表于 2019-5-4 15:44:29

批量倒角

本帖最后由 bloodtempt 于 2019-5-4 16:01 编辑

(setq ss1 (ssget "F" (list
                     (setq pt1 (vl-remove (last (setq pt1 (getpoint "选择第一组线："))) pt1))
                     (setq pt2 (vl-remove (last (setq pt2 (getpoint pt1))) pt2)))))
(setq ss2 (ssget "F" (list
                     (setq pt3 (vl-remove (last (setq pt3 (getpoint "选择第二组线："))) pt3))
                     (setq pt4 (vl-remove (last (setq pt4 (getpoint pt3))) pt4)))))
(setq i 0)
(repeat (min (sslength ss1)(sslength ss2))
(command "_.CHAMFER"
      (osnap (onwplpt (ssname ss1 i) pt1 pt2) "Near")
      (osnap (onwplpt (ssname ss2 i) pt3 pt4) "Near")
      )
(setq i (1+ i))
)
(defun onwplpt (en p1 p2 / linept lwpt pt)
(defun LWPt (en /)
    (mapcar 'cdr
      (vl-remove-if-not
      '(lambda (x) (or (= (car x) 10) (= (car x) 11)))
      (entget en)
      )
    )
)
(defun LInept (lst )
    (if (>= (length lst) 2)
      (cons (list (car lst)(cadr lst))
      (LInept
          (vl-remove
            (car Lst)
            lst
          )
      )
      )
    )
)
(mapcar '(lambda (x / inte)
             (if (setq inte (inters (car x) (cadr x) p1 p2 nil))
               (if (IsOnLine (car x) (cadr x) inte )
               inte
               )
             )
         )
    (LInept (lwpt en))
)
inte
)


；批量倒角，代码错误，不知道错在哪里了，大家给看看


xj6019 发表于 2020-8-31 10:11:00

非常给力,一直致力于寻找这么一款插件，这个能实现一部分吧，测试了一下，稍有遗憾，距离很近的线判断有问题，不能倒角，期待有人还可以改善完美一下这个插件。谢谢楼主的分享。

bloodtempt 发表于 2019-5-4 16:00:56

(defun C:fvd (/ i onwplpt pt1 pt2 pt3 pt4 ss1 ss2 vl-remz)
(defun vl-remz (pt)
    (vl-remove (last pt) pt)
)
(defun onwplpt (en p1 p2 / linept lwpt inte)
    (defun LWPt (en /)
      (mapcar 'cdr
      (vl-remove-if-not
          '(lambda (x) (or (= (car x) 10) (= (car x) 11)))
          (entget en)
      )
      )
    )
    (defun LInept (lst )
      (if (>= (length lst) 2)
      (cons (list (car lst)(cadr lst))
          (LInept
            (vl-remove
            (car Lst)
            lst
            )
          )
      )
      )
    )
    (mapcar '(lambda (x)
               (if (setq inte (inters (car x) (cadr x) p1 p2 nil))
               (if (IsOnLine (car x) (cadr x) inte )
                   inte
               )
               )
             )
      (LInept (lwpt en))
    )
    inte
)
(setq ss1 (ssget "F" (list
                         (setq pt1 (vl-remz (getpoint "选择第一组线：")))
                         (setq pt2 (vl-remz (getpoint pt1))))))
(setq ss2 (ssget "F" (list
                         (setq pt3 (vl-remz (getpoint "选择第二组线：")))
                         (setq pt4 (vl-remz (getpoint pt3))))))
(setq i 0)
(repeat (min (sslength ss1)(sslength ss2))
    (command "_.CHAMFER"
      (onwplpt (ssname ss1 i) pt1 pt2)
      (onwplpt (ssname ss2 i) pt3 pt4)
    )
    (setq i (1+ i))
)
)

都爱拿现成的，那，修改了一下，可以用了，多段线还有点毛病，再查原因


yoyoho 发表于 2019-5-4 17:55:29

缺函数 "IsOnLine"

bai2000 发表于 2019-5-4 23:28:11

不能用

春鸽带你飞 发表于 2019-5-6 12:45:47

少个函数，没法调试 错误: no function definition: ISONLINE

bloodtempt 发表于 2019-5-8 20:57:20

春鸽带你飞 发表于 2019-5-6 12:45
少个函数，没法调试 错误: no function definition: ISONLINE

(defun IsOnLine (p1 p2 px)
        (< (abs (- (+ (distance p1 px) (distance p2 px)) (distance p1 p2))) 0.001)
)

bai2000 发表于 2019-5-15 17:48:40


对多段线不能用

magicheno 发表于 2020-8-30 23:49:49

好像可以用非常给力

magicheno 发表于 2020-8-31 00:04:57

貌似会有错误，有时间会出错的
页: [1]
查看完整版本: 批量倒角