是的,多年以来未见改善,就两次呗 highflybir 发表于 2011-10-31 15:40 static/image/common/back.gif
(polar cenang(+ rad eps))
之类的可以让你直接取得圆内或者圆外的一点.
感谢高飞鸟！现上传非偏移方法的圆内外剪切程序，直接求点集的，这样速度比偏移快吗？可以批量处理的来测试一下。
(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent el pt rad
ctrim_err x zmode adist f_pts svd_os svd_cmd svd_err)
(defun ctrim_err (s)
(if(/= s "Function cancelled")
(princ(strcat "\n\n" s)) )
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
)
(defun circ_pts (cen rad segs / lst cnt)
(setq cnt 0)
(repeat segs
(setq lst (cons (polar cen (+ 0 (* cnt (/ (* pi 2) segs))) rad)
lst
)
cnt (1+ cnt)
)
)
;(setq lst (append lst (list (nth 0 lst))))
(princ)
lst
)
(setq ent (car(entsel "\nSelect circle: "))
svd_err *error*
*error* ctrim_err
svd_os(getvar "osmode")
svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(initget128 "Z X")
(setq zmode(getkword "\n输入选项 (Z内剪切/X外剪切)(默认Z内剪切): "))
(if (null zmode) (setq zmode "Z"))
(cond
((= zmode "Z") (setq adist -0.1))
((= zmode "X") (setq adist 0.1))
)
(if(and ent
(=(cdr(assoc 0(entget ent)))"CIRCLE")
)
(progn
(setq el (entget ent))
(setq pt (cdr (assoc 10 el)))
(setq rad (cdr (assoc 40 el)))
(setq f_pts(circ_pts pt (+ rad adist) 25))
(repeat 2
(command "trim" ent "" "f")
(foreach x f_pts(command x))
(command "" "")
)
(redraw)
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
)
本帖最后由 zzl9105 于 2011-11-1 16:33 编辑
为何不直接求出圆与直线的交点，直接进行裁剪呢？
楼主有没有考虑下，闭合多段线对与之相交的内部线的裁剪呀？
xiaxiang这程序很不错，能不能不局限为圆，而是扩展到所有封闭曲线？ yjr111 发表于 2011-11-6 15:23 static/image/common/back.gif
xiaxiang这程序很不错，能不能不局限为圆，而是扩展到所有封闭曲线？
考虑到这一类程序太多，就不发上来献丑了。
关键问题是，像椭圆这一类图元还可以勉强求点集，
如果不规则多线，多义线，则除了偏移，似乎没有更好的办法。
飞诗那个方向剪切做得不错，也是点集栏选方式。也可以山寨一个。
至于延伸，无非就是在grread上做做文章，也没有什么技术含量 xiaxiang 发表于 2011-11-6 17:56 static/image/common/back.gif
考虑到这一类程序太多，就不发上来献丑了。
关键问题是，像椭圆这一类图元还可以勉强求点集，
如果不规 ...
从收集的源码里找到的，剪切矩形框内的线，和你这放一起。。。不知道谁写的。。。(defun c:tt
(/ rect e0 e1 pt x ptx pty l1 i p1 p2 p1x p1y point count)
(setvar "osmode" 0)
(setq l1 nil)
(setq i 0)
(setq rect (car (entsel "\n请选择需剪切的矩形:")))
(setq e0 (entget rect))
(while (setq x (nth i e0))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p1x (nth 0 p1))
(setq p1y (nth 1 p1))
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq point (mapcar '+ p1 pt))
(setq point (mapcar '/ point '(2.0 2.0 2.0)))
(if
(and (/= (nth 0 point) p1x)
(/= (nth 0 point) ptx)
(/= (nth 1 point) p1y)
(/= (nth 1 point) pty)
)
(setq p point)
)
)
(setq l1 nil)
(command "offset" 5 rect p "")
(setq e0 (entlast))
(setq e1 (entget e0))
(princ e1)
(setq i 0)
(while (setq x (nth i e1))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p2 p1)
(command "erase" e0 "")
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(command "trim" rect "" "f" p1 pt "" "")
(setq p1 pt)
)
(command "trim" rect "" "f" p1 p2 "" "")
(setvar "osmode" 687)
)
yjr111 发表于 2011-11-6 19:18 static/image/common/back.gif
从收集的源码里找到的，剪切矩形框内的线，和你这放一起。。。不知道谁写的。。。
对正方形，经测试，可以
这个似乎不能剪多段线的，比如下图
yjr111 发表于 2011-11-6 19:18
从收集的源码里找到的，剪切矩形框内的线，和你这放一起。。。不知道谁写的。。。
感谢分享，很好用的代码
页:
1
[2]