批量extrim，有个思路，想请大大帮忙~

関吣

;;;;批量extrim
网上找到一个标形心的代码，请问高手们能不能按以下代码，做一个批量extrim，能指定PL线所在图层做为剪切边，并自动选择各图形的形心，extrim后，消去形心~~
以下为代码：
;;;;;;;;;;;
(defun c:xxxxx1 (/ ss s_x p)                ;找形心
  (COMMAND "LAYER" "M" "pt" "C"        "4" "pt" "LT" "continuous" "pt"        "")
  (setq ss (ssget))
  (setq i 0)
  (setq len (sslength ss))
  (repeat len
    (progn
      (setq s_x (ssname ss i))
      (command "_.region" s_x "")
      (setq p (vlax-get (vlax-ename->vla-object (entlast)) "centroid"))
      (entmake
        (list (cons 0 "point") (cons 8 "pt") (cons 10 p))
      )
      (setq i (+ i 1))
    )
  )
  (princ)
)

関吣

人工置顶~~~

newer

你自己手工画的图，开始和结果的，截图片贴上论坛吧，并把测试的DWG也发上来。

関吣

好的，马上发上来~

zyhandw

明经已经回复过了，可以去看看

関吣

测试图~~明经回复的是我的信息？不是批量extrim的啊~~

炫翔

给你上传图片

;试试这个，目前测试只对中间黄色的多段线有效

1. (defun C:xx( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)
   
2. (vl-load-com)
   
3. (princ "\n请选择闭合pline:")
   
4. (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)
   
5. (setq i 0)
   
6. (repeat (setq m (sslength en))
   
7.    ;(setq end (ssname en (setq m (1- m))))
   
8.    (setq end (ssname en i))
   
9.    (setq end_data (entget end))
   
10.    (ttrMin_Max)
    
11.    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))
    
12.    (setq ss (ssget "c" Pmin Pmax))
    
13.    (ssdel end ss)
    
14.    (command ".trim" end "")
    
15.    (repeat (setq n (sslength ss))
    
16.      (command (list (ssname ss (setq n (1- n))) midp))
    
17.    )
    
18.    (COMMAND "")
    
19.    (setq i (1+ i))
    
20. )
    
21. 
    
22. (princ "完成！")
    
23. )
    
24. 
    
25. (defun ttrMin_Max()
    
26. (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
    
27. (setq minp (vlax-safearray->list minp)
    
28.        maxp (vlax-safearray->list maxp))
    
29. (setq minx (car minp)
    
30.        maxx (car maxp)
    
31.        miny (cadr minp)
    
32.        maxy (cadr maxp))
    
33. (setq pmin (list minx miny)
    
34.        pmax (list maxx maxy))
    
35. )
    
36. 
    
37. 
    

(defun C:xx( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)<br /> (vl-load-com)<br /> (princ "\n请选择闭合pline:")<br /> (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)<br /> (setq i 0)<br /> (repeat (setq m (sslength en))<br />    ;(setq end (ssname en (setq m (1- m))))<br />    (setq end (ssname en i))<br />    (setq end_data (entget end))<br />    (ttrMin_Max)<br />    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))<br />    (setq ss (ssget "c" Pmin Pmax))<br />    (ssdel end ss)<br />    (command ".trim" end "")<br />    (repeat (setq n (sslength ss))<br />      (command (list (ssname ss (setq n (1- n))) midp))<br />    )<br />    (COMMAND "")<br />    (setq i (1+ i))<br /> )<br /> <br /> (princ "完成！")<br /> )<br /> <br /> (defun ttrMin_Max()<br /> (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)<br /> (setq minp (vlax-safearray->list minp)<br />        maxp (vlax-safearray->list maxp))<br /> (setq minx (car minp)<br />        maxx (car maxp)<br />        miny (cadr minp)<br />        maxy (cadr maxp))<br /> (setq pmin (list minx miny)<br />        pmax (list maxx maxy))<br /> )<br /> <br /> <br />

関吣

炫翔 发表于 2013-7-11 11:14
给你上传图片

;试试这个，目前测试只对中间黄色的多段线有效

这个我有哦。但是这个插件好像找形心有问题~

newer

関吣 发表于 2013-7-11 11:20
这个我有哦。但是这个插件好像找形心有问题~

用前加载XDRX_API

1. (defun c:tt ()
   
2.   (if (progn
   
3.         (prompt "\n选取封闭的多段线<退出>:")
   
4.         (setq ss (ssget '((0 . "*polyline"))))
   
5.       )
   
6.     (progn
   
7.       (xdrx_begin)
   
8.       (xdrx_setsstodb ss 0)
   
9.       (while (setq e (xdrx_getentdata 0))
   
10.         (if (and
    
11.               (= 1 (logand (xdrx_getentdxf 70) 1))
    
12.               (setq ss1 (ssget "f" (xdrx_getsamplept e) '((0 . "*line,arc,ellipse,circle"))))
    
13.               (ssdel e ss1)
    
14.               (> (sslength ss1) 0)
    
15.             )
    
16.              (xdrx_pickset_ClipbyPoly ss1 e)
    
17.         )
    
18.       )
    
19.       (xdrx_end)
    
20.     )
    
21.   )
    
22.   (princ)
    
23. )
    
24. 
    

(defun c:tt ()<br />   (if (progn<br />         (prompt "\n选取封闭的多段线<退出>:")<br />         (setq ss (ssget '((0 . "*polyline"))))<br />       )<br />     (progn<br />       (xdrx_begin)<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (if (and<br />               (= 1 (logand (xdrx_getentdxf 70) 1))<br />               (setq ss1 (ssget "f" (xdrx_getsamplept e) '((0 . "*line,arc,ellipse,circle"))))<br />               (ssdel e ss1)<br />               (> (sslength ss1) 0)<br />             )<br />              (xdrx_pickset_ClipbyPoly ss1 e)<br />         )<br />       )<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

yzr2002626

这样的修剪像结构中的修剪梁，墙

onemax

炫翔 发表于 2013-7-11 11:14
给你上传图片

;试试这个，目前测试只对中间黄色的多段线有效

经测试，这个程序在选择多段线时因没加封闭判断，在选择非封闭多段线时会漏剪缺口处的对象，另外当被修剪的多段线在多次经过剪裁线时（超过3个相交点）只会裁剪其中一段而忽略剪裁其余在剪裁范围内的线段

相信自己666

炫翔 发表于 2013-7-11 11:14
给你上传图片

;试试这个，目前测试只对中间黄色的多段线有效

老师这个程序能不能把要修改的程充改成块啊，把批量把块内线修剪掉，麻烦老师看看

f4800

非常不错的技术和思路。。。学习了。。。

dmxcs

非常不错的技术和思路。。。学习了。。。