请教如何以图块最外层的边界修剪图块下面的直线？
本帖最后由 xyxy 于 2011-12-1 09:08 编辑如题。
一条直线上有一个或多个图块，如何框选图块以图块的最外层边界线修剪此直线？
谢谢！
示意如下。
本帖最后由 xiaxiang 于 2011-12-1 11:31 编辑
这是一个打断的程序
(defun c:BLKTRIM ( / *error* trim-blk rotate-bbox sv-cmd
sv-osm acad-doc ss cnt)
(defun *error* (msg)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
)
(defun trim-blk (pts / ln-set ln-obj sp ep tmp int-lst ct)
(if(setq ln-set(ssget "cp" pts '((0 . "*LINE,ARC"))))
(progn
(setq pts(reverse(cons(car pts)(reverse pts))))
(repeat(setq ct(sslength ln-set))
(setq ln-obj(vlax-ename->vla-object
(ssname ln-set
(setq ct(1- ct))
)
)
sp (vlax-curve-getStartPoint ln-obj)
ep (vlax-curve-getEndPoint ln-obj)
tmp pts
int-lst '()
)
(while(>(length tmp)1)
(if(setq int(inters sp ep(car tmp)(cadr tmp)nil))
(if(inters sp int (car tmp)(cadr tmp))
(setq int-lst(cons int int-lst))
)
)
(setq tmp(cdr tmp))
)
(if(=(length int-lst)2)
(vl-cmdf "_.break"
(list
(vlax-vla-object->ename ln-obj)
(car int-lst)
)
(cadr int-lst)
)
)
)
)
)
)
(defun rotate-bbox (blk-obj / mspace blk-rot blk-pt blk-bbox
p1 p2 p3 p4 x tmp)
(setq mspace (vla-get-modelspace acad-doc)
blk-rot(vlax-get-property blk-obj 'Rotation)
blk-pt (vlax-get-property blk-obj 'InsertionPoint)
)
(vlax-put-property blk-obj 'Rotation 0.0)
(setq blk-bbox (vla-getBoundingBox blk-obj 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p1 (list(car p1)(cadr p1))
p3 (list(car p3)(cadr p3))
p2 (list(car p1)(cadr p3))
p4 (list(car p3)(cadr p1))
)
(vlax-put-property blk-obj 'Rotation blk-rot)
(foreach x '(p1 p2 p3 p4)
(vla-rotate
(vla-addpoint mspace(vlax-3d-point(eval x)))
blk-pt
blk-rot
)
(set x(vlax-ename->vla-object(entlast)))
)
(foreach x '(p1 p2 p3 p4)
(setq tmp(eval x))
(set x
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property(eval x)'Coordinates)
)
)
)
(vla-delete tmp)
)
(list p1 p2 p3 p4)
)
(setq sv-cmd (getvar "cmdecho")
sv-osm (getvar "osmode")
acad-doc (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vla-StartUndoMark acad-doc)
(if(setq ss(ssget '((0 . "INSERT"))))
(repeat(setq cnt(sslength ss))
(trim-blk
(rotate-bbox
(vlax-ename->vla-object
(ssname ss
(setq cnt(1- cnt))
)
)
)
)
)
)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
(princ)
)
3、4、11楼的程序内容都很实用，虽然有功能重叠，都能做为学习的依据，感谢分享。 有没有哪位高手能帮解决一下？非常感谢！ 非自动(defun C:trimblk (/ pt1 pt2 el et)
(command "undo" "be")
(setq os (getvar "osmode"))
(setvar "osmode" 32)
(setq pt1 (getpoint "\n选择块与直线第一个交点: "))
(setq pt2 (getpoint pt1 "\n选择块与直线第二个交点 "))
(command "circle" "2p" pt1 pt2 )
(redraw (setq el (entlast)) 2)
(while (setq et (getpoint "\n选择被剪切的直线 (回车结束):"))
(command "trim" el "" et "" )
);while
(command "erase" el "" )
(setvar "osmode" os)
(command "redraw")
(command "undo" "e")
) 本帖最后由 xyxy 于 2011-12-1 11:44 编辑
xiaxiang大侠提供的4#程序能满足我的要求，再次感谢热心的xiaxiang！ xyxy 发表于 2011-12-1 11:33 static/image/common/back.gif
xiaxiang大侠提供的4#程序能满足我的要求，再次感谢热心的xiaxiang！
老兄，这个问题解决了？ longer1000 发表于 2012-5-22 18:00 static/image/common/back.gif
老兄，这个问题解决了？
longer1000兄，xiaxiang大侠提供的程序已经能满足我所需的要求，谢谢关注！ xyxy 发表于 2012-5-22 19:48 static/image/common/back.gif
longer1000兄，xiaxiang大侠提供的程序已经能满足我所需的要求，谢谢关注！
能否分享下，或者发邮箱longer1000@sina.com，谢谢 longer1000兄，xiaxiang大侠提供的程序就在3楼和4楼，复制即可使用。 xiaxiang 发表于 2011-12-1 11:31 static/image/common/back.gif
这是一个打断的程序
非常实用的程序！如果能把图示小bug完善一下就更好了！
页:
[1]
2