文字在直线处断开

笑2笑

执行前:



执行后:

XDSoft

插个楼，上次的悬赏如果不知道如何结算，看看这个帖子：http://bbs.xdcad.net/thread-668286-1-1.html

如果你满意了，给帮助你的人结算去吧。

ll_j

这个功能不需要另外编写程序，如果需要直线真正断开，就用剪切命令，如果不要真正断开，就用ET的textmask功能。

ScmTools

利用文字外框或遮蔽实体都可以

newer

ll_j 发表于 2013-5-25 14:49
这个功能不需要另外编写程序，如果需要直线真正断开，就用剪切命令，如果不要真正断开，就用ET的textmask功 ...

长老，人家发这个版块，就是希望学写程序嘛，要不就发到其他版块了。

炫翔

看图片，貌似不是遮蔽，
给个简单笨拙的思路:
获取文字的对角坐标，画多段线，选取直线用矩形来修剪，删除矩形

ysq101

好主意!!!!!!!可惜还没学到!!!!

夜来风语声

2. (defun c:tt ()
   
3.   (setq ss (ssget '((0 . "text"))))
   
4.   (repeat (setq n (sslength ss))
   
5.     (setq e (ssname ss (setq n (1- n))))
   
6.     (vla-GetBoundingBox (vlax-ename->vla-object e) 'll 'ur)
   
7.     (setq ll (vlax-safearray->list ll)
   
8.           ur (vlax-safearray->list ur)
   
9.           cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))
   
10.     )
    
11.     (setq s (ssget "c"
    
12.                    (trans ll 0 1)
    
13.                    (trans ur 0 1)
    
14.                    '((0 . "*line,arc,ellipse,circle"))
    
15.             )
    
16.     )
    
17.     (if        s
    
18.       (progn
    
19.       (command "_trim" e "" (list (ssname s 0) (trans cp 0 1)) "")
    
20.       )
    
21.     )
    
22. 
    
23.   )
    
24. )

(defun c:tt ()<br />   (setq ss (ssget '((0 . "text"))))<br />   (repeat (setq n (sslength ss))<br />     (setq e (ssname ss (setq n (1- n))))<br />     (vla-GetBoundingBox (vlax-ename->vla-object e) 'll 'ur)<br />     (setq ll (vlax-safearray->list ll)<br />           ur (vlax-safearray->list ur)<br />           cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ll ur))<br />     )<br />     (setq s (ssget "c"<br />                    (trans ll 0 1)<br />                    (trans ur 0 1)<br />                    '((0 . "*line,arc,ellipse,circle"))<br />             )<br />     )<br />     (if        s<br />       (progn<br />       (command "_trim" e "" (list (ssname s 0) (trans cp 0 1)) "")<br />       )<br />     )<br /> <br />   )<br /> )

ll_j

炫翔 发表于 2013-5-25 15:21
看图片，貌似不是遮蔽，
给个简单笨拙的思路:
获取文字的对角坐标，画多段线，选取直线用矩形来修剪，删 ...

文字直接可以做剪刀。

Gdlprfcu

执行后效果：

2. (defun c:test(/ ss->objlist trimtext SS textss liness textobjs lineobjs)
   
3. (defun ss->objlist(ss class / n i objs)
   
4.   (setq n (sslength ss))
   
5.   (setq i 0)
   
6.   (repeat n
   
7.    (setq obj(vlax-ename->vla-object (ssname ss i)))
   
8.    (if(=( vla-get-objectname obj) class)
   
9.    (setq objs(cons obj objs))
   
10.    )
    
11.    (setq i(1+ i))
    
12.    )
    
13.   (setq objs(reverse objs))
    
14.   )
    
15. (defun trimtext(textobj lineobj / error pts pt1 pt2 startpt ownerobj newline doc Ownerobj)
    
16.   (setq error(vl-catch-all-error-p(setq pts(vl-catch-all-apply 'vlax-safearray->list(list(vlax-variant-value (vla-IntersectWith lineobj textobj 0)))))))
    
17.   (if(and (not error)(=(length pts)6))
    
18.    (progn
    
19.     (setq pt1 (list (car pts)(cadr pts)(caddr pts))
    
20.      pt2(list (nth 3 pts)(nth 4 pts)(nth 5 pts)))
    
21.     (setq startpt(vlax-get lineobj 'StartPoint))
    
22.     (setq doc(vlax-get (vlax-get-acad-object) 'ActiveDocument))
    
23.     (setq Ownerobj(vla-objectidtoobject doc (vla-get-ownerid lineobj )))
    
24.     (if (<(distance startpt pt1)(distance startpt pt2))
    
25.      (progn
    
26.       (setq newline(vla-addline ownerobj (vlax-3d-point pt2)(vla-get-endpoint lineobj)))
    
27.       (vlax-put lineobj 'EndPoint pt1)
    
28.       )
    
29.      (progn
    
30.       (setq newlien(vla-addline ownerobj (vlax-3d-point pt1)(vla-get-endpoint lineobj)))
    
31.       (vlax-put lineobj 'EndPoint pt2)
    
32.       )
    
33.      )
    
34.     )
    
35.    )
    
36.   newline
    
37. )
    
38.    (vl-load-com)
    
39. (princ "\n选择直线和文字")
    
40. (if(setq ss(ssget '((-4 . "<OR")(0 . "TEXT")(0 . "LINE")(-4 . "OR>"))))
    
41.   (progn
    
42.    (setq textobjs(ss->objlist ss "AcDbText"))
    
43.    (setq lineobjs(ss->objlist ss "AcDbLine"))
    
44.    (if(and textobjs textobjs)
    
45.     (progn
    
46.      (foreach textobj textobjs
    
47.       (foreach lineobj lineobjs
    
48.        (if(setq newline(trimtext textobj lineobj))
    
49.          (setq lineobjs(cons newline  lineobjs ))
    
50.          )
    
51.        )
    
52.       )
    
53.      )
    
54.     )
    
55.    )
    
56.   )
    
57. )
    

(defun c:test(/ ss->objlist trimtext SS textss liness textobjs lineobjs)<br /> (defun ss->objlist(ss class / n i objs)<br />   (setq n (sslength ss))<br />   (setq i 0)<br />   (repeat n<br />    (setq obj(vlax-ename->vla-object (ssname ss i)))<br />    (if(=( vla-get-objectname obj) class)<br />    (setq objs(cons obj objs))<br />    )<br />    (setq i(1+ i))<br />    )<br />   (setq objs(reverse objs))<br />   )<br /> (defun trimtext(textobj lineobj / error pts pt1 pt2 startpt ownerobj newline doc Ownerobj)<br />   (setq error(vl-catch-all-error-p(setq pts(vl-catch-all-apply 'vlax-safearray->list(list(vlax-variant-value (vla-IntersectWith lineobj textobj 0)))))))<br />   (if(and (not error)(=(length pts)6))<br />    (progn <br />     (setq pt1 (list (car pts)(cadr pts)(caddr pts))<br />      pt2(list (nth 3 pts)(nth 4 pts)(nth 5 pts)))<br />     (setq startpt(vlax-get lineobj 'StartPoint))<br />     (setq doc(vlax-get (vlax-get-acad-object) 'ActiveDocument))<br />     (setq Ownerobj(vla-objectidtoobject doc (vla-get-ownerid lineobj )))<br />     (if (<(distance startpt pt1)(distance startpt pt2))<br />      (progn<br />       (setq newline(vla-addline ownerobj (vlax-3d-point pt2)(vla-get-endpoint lineobj)))<br />       (vlax-put lineobj 'EndPoint pt1)<br />       )<br />      (progn<br />       (setq newlien(vla-addline ownerobj (vlax-3d-point pt1)(vla-get-endpoint lineobj)))<br />       (vlax-put lineobj 'EndPoint pt2)<br />       )<br />      )<br />     )<br />    )<br />   newline<br /> )<br />    (vl-load-com)<br /> (princ "\n选择直线和文字")<br /> (if(setq ss(ssget '((-4 . "<OR")(0 . "TEXT")(0 . "LINE")(-4 . "OR>"))))<br />   (progn<br />    (setq textobjs(ss->objlist ss "AcDbText"))<br />    (setq lineobjs(ss->objlist ss "AcDbLine"))<br />    (if(and textobjs textobjs)<br />     (progn<br />      (foreach textobj textobjs <br />       (foreach lineobj lineobjs<br />        (if(setq newline(trimtext textobj lineobj))<br />          (setq lineobjs(cons newline  lineobjs ))<br />          )<br />        )<br />       )<br />      )<br />     )<br />    )<br />   )<br /> )<br />

Gdlprfcu

楼主，我的程序不好用吗？怎么都还不给分？

yoyoho

感谢分享程序!

拉契

感谢楼主出题，感谢各位的代码！学习了

sunshinejwt

10楼的程序很好用，就是将直线打断后，文字后的线的图层变为文字的图层了。能不能改为不改变图层，还是用打断前的图层。