全部的币都拿出来了！求实现自动TRIM功能！

革天明

Andyhon 发表于 2012-4-28 11:42
调试与结果

Command: (setq xxset (mapcar 'car (get '10 (mapcar 'entget (sslist (ssget))))))

你的效果效果确实很好，但你能将完整的LSP发一下吗，高手对调试都很在行，我对每个函数具体的动作都还不能完全摸透，只是会调用，所以您能将完整的LSP写一下吗，半成品的代码我上传的很多，程序也简单，只是对于图元的操控我比较弱，加上第一次使用TRIM BREAK boundry等，

革天明

第一次发布悬赏终于弄好了，http://www.mccad.net/index.php?do=task&task_id=7
有点少，我没有想到这个问题这么难，大家认为这个问题多少钱合适呢？
我的使用环境：XP CAD20006 机械版，一般没有装 ET工具，

革天明

革天明 发表于 2012-4-28 11:36
红色是我加上去的，红色部分有一个分界槽没有剪开

原来是白线，生成白线很简单，这个地方没有问题，是我改成红色，为了醒目，但此处有线却没有将分界槽剪开

flytoday

flytoday 发表于 2012-4-28 08:00
院长很那个那个…发内裤码…这个还只发张图片……

院你您大师能不能不公布内裤码呢。。

对您大师来说。。得让小辈多学点东西啊。。

藏着。。。藏着。。。。[em0]

Andyhon

...没有将分界槽剪开...

您得将产生上述情况的图纸(*.Dwg)上传,才好 Debugging ...

革天明

Andyhon 发表于 2012-4-28 12:14
...没有将分界槽剪开...

您得将产生上述情况的图纸(*.Dwg)上传,才好 Debugging ...

例子在下面

革天明

高手们，就差最后一脚了，再完善一下就成功了！加油！

flytoday

flytoday 发表于 2012-4-28 12:11
院你您大师能不能不公布内裤码呢。。

对您大师来说。。得让小辈多学点东西啊。。

哈哈院长回答真高名哈。。。。。

对您这样滴大师来说。。得让小辈多学点东西啊。。要公布点好东东哦

Andyhon

只通过 55# 所举例子

2. 
   
3. ;;; 计算两点的中点
   
4. (defun mpt (mpt1 mpt2)
   
5.   (polar mpt1 (angle mpt1 mpt2) (/ (distance mpt1 mpt2) 2))
   
6. )
   
7. 
   
8. (defun Dvl (ptLst / pxs)
   
9.    (foreach pts Ptlst
   
10.       (setq p5 (apply 'mpt pts)
    
11.             px (car p5)
    
12.            pxs (cons px pxs)
    
13.             p6 (list px y0)
    
14.       )
    
15.       (entmake (list '(0 . "LINE") (cons 10 p6) (cons 11 p5)))
    
16.       (ssadd (entlast) ss3)
    
17.    )
    
18.    pxs
    
19. )
    
20. 
    
21. (defun gt2Pts (a)
    
22.    (list
    
23.       (vlax-curve-getStartPoint a)
    
24.       (vlax-curve-getEndPoint a)
    
25.    )
    
26. )
    
27. 
    
28. (defun findV (ss / ptss)
    
29.    (setq nn (sslength ss)
    
30.          nn (1- nn)
    
31.    )
    
32.    (while (setq ee (ssname ss nn))
    
33.      (setq pts (gt2Pts ee)
    
34.             dd (apply 'mapcar (cons '- pts))
    
35.             dd (mapcar 'abs dd)
    
36.             nn (1- nn)
    
37.      )
    
38.      (if (equal (car dd) (cadr dd) 1e-4)
    
39.        (setq ptss (cons pts ptss))
    
40.    ) )
    
41.    ptss
    
42. )
    
43. 
    
44. (defun c:test ()
    
45.    (setq ss (ssget))
    
46.    (command "PEDIT" "M" ss "" "Y" "J" "" "")
    
47.    (setq eepl (entlast))
    
48.    (command "Explode" eepl)
    
49.    (setq ss (ssget "P")
    
50.         ss2 (findV ss)
    
51.         ss3 (ssadd)
    
52.    )
    
53. 
    
54.    (command "PEDIT" "M" ss "" "Y" "J" "" "")
    
55.    (setq eepl (entlast))
    
56.    (vla-getboundingbox (vlax-ename->vla-object eePl) 'minpt 'maxpt)
    
57.    (setq ;; eepl (entlast)
    
58.          ;; pts (acet-ent-geomextents eePl)
    
59.          pts (list (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
    
60.           p1 (car pts)
    
61.           p3 (cadr pts)
    
62.           x0 (car p1)
    
63.           x9 (car p3)
    
64.           y0 (cadr p1)
    
65.           y5 (+ y0  2)
    
66.           pa (list (+ x0 1) y5)
    
67.         nxtx (cdr (Dvl ss2))
    
68.    )
    
69.    (setvar "OsMode" 0)
    
70.    (command "boundary" pa)
    
71.      (while (setq pbx (car nxtx))
    
72.        (setq nxtx (cddr nxtx)
    
73.                pb (list (+ pbx 1) y5)
    
74.        )
    
75.        (command pb)
    
76.      )
    
77.    (command "")
    
78.    (setq ss2 (ssget "w" p1 p3))
    
79.    (command "erase" eepl ss3 "")
    
80. )
    

<br /> ;;; 计算两点的中点<br /> (defun mpt (mpt1 mpt2)<br />   (polar mpt1 (angle mpt1 mpt2) (/ (distance mpt1 mpt2) 2))<br /> )<br /> <br /> (defun Dvl (ptLst / pxs)<br />    (foreach pts Ptlst<br />       (setq p5 (apply 'mpt pts)<br />             px (car p5)<br />            pxs (cons px pxs)<br />             p6 (list px y0)<br />       )<br />       (entmake (list '(0 . "LINE") (cons 10 p6) (cons 11 p5)))<br />       (ssadd (entlast) ss3)<br />    )<br />    pxs<br /> )<br /> <br /> (defun gt2Pts (a)<br />    (list<br />       (vlax-curve-getStartPoint a)<br />       (vlax-curve-getEndPoint a)<br />    )<br /> )<br /> <br /> (defun findV (ss / ptss)<br />    (setq nn (sslength ss)<br />          nn (1- nn)<br />    )<br />    (while (setq ee (ssname ss nn))<br />      (setq pts (gt2Pts ee)<br />             dd (apply 'mapcar (cons '- pts))<br />             dd (mapcar 'abs dd)<br />             nn (1- nn)<br />      )<br />      (if (equal (car dd) (cadr dd) 1e-4)<br />        (setq ptss (cons pts ptss))<br />    ) )<br />    ptss<br /> )<br /> <br /> (defun c:test ()<br />    (setq ss (ssget))<br />    (command "PEDIT" "M" ss "" "Y" "J" "" "")<br />    (setq eepl (entlast))<br />    (command "Explode" eepl)<br />    (setq ss (ssget "P")<br />         ss2 (findV ss)<br />         ss3 (ssadd)<br />    )<br /> <br />    (command "PEDIT" "M" ss "" "Y" "J" "" "")<br />    (setq eepl (entlast))<br />    (vla-getboundingbox (vlax-ename->vla-object eePl) 'minpt 'maxpt)<br />    (setq ;; eepl (entlast)<br />          ;; pts (acet-ent-geomextents eePl)<br />          pts (list (vlax-safearray->list minpt) (vlax-safearray->list maxpt))<br />           p1 (car pts)<br />           p3 (cadr pts)<br />           x0 (car p1)<br />           x9 (car p3)<br />           y0 (cadr p1)<br />           y5 (+ y0  2)<br />           pa (list (+ x0 1) y5)<br />         nxtx (cdr (Dvl ss2))<br />    )<br />    (setvar "OsMode" 0)<br />    (command "boundary" pa)<br />      (while (setq pbx (car nxtx))<br />        (setq nxtx (cddr nxtx)<br />                pb (list (+ pbx 1) y5)<br />        )<br />        (command pb)<br />      )<br />    (command "")<br />    (setq ss2 (ssget "w" p1 p3))<br />    (command "erase" eepl ss3 "")<br /> )<br />

参股银行

帮你顶
也想了解