[求助]：一次点击保留中段（剪去两端）线怎么实现？

li_seagull · 发表于 2005-3-22 12:28:44

LUCAS 斑竹你好,能不能给我一个源找码,谢谢!
www_sea@163.com

xyp1964 · 发表于 2005-3-22 13:16:13

LUCAS 的程序确实很好使！

ljpnb · 发表于 2005-3-22 14:14:51

我不知道对圆、椭圆等类型的如何操作，对直线和圆弧我也编写了一个，能实现功能，原理同10楼的一样。LUCAS能否提示一下，对圆和椭圆如何实现。我有另外一种想法就是不选择边界进行trim操作，在trim后，先取出想要的两个点，再undo，然后break两个点之间不要的部份。

LUCAS · 发表于 2005-3-22 16:30:54

原理與10樓完全不同,你的另外一种想法較接近

aeo · 发表于 2005-3-22 22:00:59

*polyline 如果首尾相连，但不闭合，应该留下两部分.

aeo · 发表于 2005-3-22 22:47:33

用xd_api写了一个
不想用api的,自己翻译成vlisp吧

图例就LUCAS的吧
解决了多义线的问题

有bug提出来.

(defun c:t1( / bou curve e el en p pt pts ss x y br: rdraw ss1 poly:)
(defun br:(e p / ang p1)
(setq ang(angle '(0 0 0)(xdrx_curve_getFirstDeriv e p))
p1(polar p ang 1e-3)
)
(command "break"(list e p)"F"p p1)
)
(defun rdraw(ss n / i) ;;redraw
(if ss(progn
(setq i -1)
(repeat(sslength ss)(redraw(ssname ss(setq i(1+ i)))n))
))
)
(defun poly:(e / pts) ;;首尾相连pl
(if(and(= 0(xdrx_GetEntDxf 70))
(setq pts( xdrx_curve_GetPoint e))
(equal(car pts)(last pts)1e-3)
)
(xdrx_ModEnt 70 1)
)
t
)
;;;-------
(xdrx_begin '("cmdecho" 0))
(princ "\n选择边界(回车全部): ")
(setq curve '((0 . "*LINE,ARC,ELL*,CIR*")));;dim也能做，但很复杂
(setq ss(ssget curve))
(rdraw ss 3)
(while(and
(setq e (xdrx_entsel "\n选择要保留的段: " curve))
(setq pt(cadr e)
e(car e)
el(entlast)
)
(or ss
(setq bou(xdrx_entity_box e) ;;如果没边界，那就所有相交的.
ss(ssget "C"(car bou)(caddr bou)curve)
)
)
(progn(ssdel e ss)t)
(>(sslength ss)0)
(setq pts(xdrx_getinters e ss 0));;所有交点
(xdrx_SetEntToDb e)
(setq name (xdrx_GetEntDxf 0))
(if(wcmatch name "CIR*,ELL*") ;;圆，椭圆要两个交点
(> (length pts)1)
t
)
(if(wcmatch name "*POLYLINE")
(poly: e) t ;;pl 首尾相连&不闭合:处理一下
)
)
(progn
(if(or (wcmatch(cdr(assoc 0(entget e)))"CIR*,ELL*");;处理 :圆，椭圆
(and (wcmatch name "*POLYLINE") ;; :闭合多义线
(= 1(xdrx_GetEntDxf 70))
)
)
(br: e (car pts))
)
(setq pts (vl-sort pts
'(lambda(x y)(>(xdrx_curve_getParamAtPoint e x)
(xdrx_curve_getParamAtPoint e y)
)
))
)
(foreach p pts ;;所有交点打断
(command "break"(list e p)"f"p p)
)
(setq ss1(ssget pt))
(command "erase" e) ;;不要的删除
(while(setq el(entnext el))(command el))
(command "R" ss1 "")
)
)
(rdraw ss 4)
(xdrx_end)
(princ)
)

(defun c:t1( / bou curve e el en p pt pts ss x y br: rdraw ss1 poly:) 
  (defun br:(e p / ang p1) 
    (setq ang(angle '(0 0 0)(xdrx_curve_getFirstDeriv e p)) 
          p1(polar p ang 1e-3) 
    ) 
    (command "break"(list e p)"F"p p1) 
  ) 
  (defun rdraw(ss n / i) ;;redraw 
   (if ss(progn 
     (setq i -1) 
     (repeat(sslength ss)(redraw(ssname ss(setq i(1+ i)))n)) 
   )) 
  ) 
  (defun poly:(e / pts) ;;首尾相连pl 
    (if(and(= 0(xdrx_GetEntDxf 70)) 
          (setq pts( xdrx_curve_GetPoint e)) 
          (equal(car pts)(last pts)1e-3) 
       ) 
       (xdrx_ModEnt 70 1) 
    ) 
    t 
  ) 
 ;;;------- 
  (xdrx_begin '("cmdecho" 0)) 
  (princ "\n选择边界(回车全部): ") 
  (setq curve '((0 . "*LINE,ARC,ELL*,CIR*")));;dim也能做，但很复杂 
  (setq ss(ssget curve)) 
  (rdraw ss 3) 
  (while(and 
          (setq e (xdrx_entsel "\n选择要保留的段: " curve)) 
          (setq pt(cadr e) 
                e(car e) 
                el(entlast) 
          ) 
          (or ss 
            (setq bou(xdrx_entity_box e) ;;如果没边界，那就所有相交的. 
                  ss(ssget "C"(car bou)(caddr bou)curve) 
            ) 
          ) 
         (progn(ssdel e ss)t) 
         (>(sslength ss)0) 
         (setq pts(xdrx_getinters e ss 0));;所有交点 
         (xdrx_SetEntToDb e) 
         (setq name (xdrx_GetEntDxf 0)) 
         (if(wcmatch name "CIR*,ELL*") ;;圆，椭圆要两个交点 
             (> (length pts)1) 
             t 
         ) 
         (if(wcmatch name "*POLYLINE") 
                (poly: e) t   ;;pl 首尾相连&不闭合:处理一下 
         ) 
     ) 
     (progn 
      (if(or (wcmatch(cdr(assoc 0(entget e)))"CIR*,ELL*");;处理  :圆，椭圆 
             (and (wcmatch name "*POLYLINE")             ;;      :闭合多义线 
                  (= 1(xdrx_GetEntDxf 70)) 
             ) 
         ) 
         (br: e (car pts)) 
      ) 
      (setq pts (vl-sort pts 
                 '(lambda(x y)(>(xdrx_curve_getParamAtPoint e x) 
                                (xdrx_curve_getParamAtPoint e y) 
                              ) 
                 )) 
      ) 
      (foreach p pts               ;;所有交点打断 
        (command "break"(list e p)"f"p p) 
      ) 
      (setq ss1(ssget pt)) 
      (command "erase" e)          ;;不要的删除 
      (while(setq el(entnext el))(command el)) 
      (command "R" ss1 "") 
     ) 
   ) 
   (rdraw ss 4) 
   (xdrx_end) 
   (princ) 
)

LUCAS · 发表于 2005-3-23 15:25:05

aeo兄:傳圖供測試,功能還有一些bug
ps:我提供的程序已更新(3月23日下午03:51)

whzhen · 发表于 2005-3-23 20:21:03

忙了几天没上网，再来一看这个话题有了不少跟帖，对斑竹提供的程序很满意，非常感谢。

陌生人 · 发表于 2005-3-23 23:52:58

龙兄用trim的方法应该比aeo的写法简短

LUCAS · 发表于 2005-3-24 12:23:41

陌生人兄:我用trim & lengthen 越寫越長,發現問題越多,有空要再重寫一次 8-(

li_seagull · 发表于 2005-3-24 12:35:15

LUCAS 斑竹你好,能不能给我一个源找码,谢谢!
www_sea@163.com

LUCAS · 发表于 2005-3-24 14:56:04

;;By LUCAS(龍龍仔)
;;這是最初版本,錯漏百出,供你參考!
;;後來程序越來越難看,不便貼出.
;;(*polyline & spline---閉合&首尾點重合沒有弄好) 8-(
;;線類思路
;;1.在trim後，先取出想要的(1~2個點)，再undo
;;2.計算trim後線長度,用lengthen調整線長
;;圓、橢圓思路
;;1.正常trim圓、橢圓
;;2.修改端點(交換)
(defun C:TRIM_REMAIN (/ DATA50 DATA51 ENT ENTT ENTTT
HOLDECHO LEND LENT LSTART PT10
PT11 SS TYP E42
)
(vl-load-com)
(defun DO_IT ()
(if (member PT11
(list (vlax-curve-getstartpoint ENTT)
(vlax-curve-getendpoint ENTT)
)
)
(command "_.undo"
1
"_.lengthen"
"de"
(- LSTART)
(list (car ENT) PT11)
""
)
(command "_.undo"
1
"_.lengthen"
"de"
(- LSTART)
(list (car ENT) PT10)
""
)
)
)
(setq HOLDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.UNDO" "_GROUP")
(while
(and (setq
ENT (entsel "\n選取保留段: ")
)
(setq TYP (cdr (assoc 0 (entget (car ENT)))))
(wcmatch TYP "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE")
)
(if (wcmatch TYP "ELLIPSE")
(setq E42 (cdr (assoc 42 (entget (car ENT)))))
)
(setq ENTT (vlax-ename->vla-object (car ENT)))
(setq PT10 (vlax-curve-getstartpoint ENTT)
PT11 (vlax-curve-getendpoint ENTT)
)
(setq LENT (entlast))
(command "_.select" "all" "r" (car ENT) "")
(setq SS (ssget "p"))
(command "_.trim" "l" "" "p" "n" "e" "n" "" "_.trim" SS "" ENT "")
(if (wcmatch (cdr (assoc 0 (entget (entlast))))
"*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE"
)
(setq LEND (vlax-curve-getdistatparam
(setq ENTTT (vlax-ename->vla-object (entlast)))
(vlax-curve-getendparam ENTTT)
)
)
)
(cond
((and (wcmatch TYP "POLYLINE")
(not (equal LENT (entlast)))
)
(setq LSTART
(vlax-curve-getdistatparam
(setq ENTT (vlax-ename->vla-object (entnext LENT)))
(vlax-curve-getendparam ENTT)
)
)
(if (not (equal (entnext LENT) (entlast)))
(command "_.undo"
1
"_.lengthen"
"de"
(- LSTART)
(list (car ENT) PT10)
""
"_.lengthen"
"de"
(- LEND)
(list (entlast) PT11)
""
)
(DO_IT)
)
)
((wcmatch TYP "CIRCLE")
(setq ENT
(entget (ssname (ssget "X"
(list (cons 0 "ARC")
(assoc 10 (entget (car ENT)))
)
)
0
)
)
)
(setq DATA50 (cdr (assoc 50 ENT)))
(setq DATA51 (cdr (assoc 51 ENT)))
(setq ENT (vl-remove (assoc 50 ENT) ENT))
(setq ENT (vl-remove (assoc 51 ENT) ENT))
(setq
ENT (append ENT (list (cons 50 DATA51) (cons 51 DATA50)))
)
(entmod ENT)
(command "_.move" (cdr (assoc -1 ENT)) "" "0,0" "@")
)
((and (wcmatch TYP "ELLIPSE")
(equal E42 6.28318530717 0.00000000001)
)
(setq ENT
(entget (ssname (ssget "X"
(list (cons 0 "ELLIPSE")
(assoc 10 (entget (car ENT)))
)
)
0
)
)
)
(setq DATA50 (cdr (assoc 41 ENT)))
(setq DATA51 (cdr (assoc 42 ENT)))
(setq ENT (vl-remove (assoc 41 ENT) ENT))
(setq ENT (vl-remove (assoc 42 ENT) ENT))
(setq
ENT (append ENT (list (cons 41 DATA51) (cons 42 DATA50)))
)
(entmod ENT)
(command "_.move" (cdr (assoc -1 ENT)) "" "0,0" "@")
)
(t
(setq LSTART (vlax-curve-getdistatparam
ENTT
(vlax-curve-getendparam ENTT)
)
)
(if (not (equal (entlast) LENT))
(command "_.undo"
1
"_.lengthen"
"de"
(- LSTART)
(list (car ENT) PT10)
""
"_.lengthen"
"de"
(- LEND)
(list (car ENT) PT11)
""
)
(DO_IT)
)
)
)
)
(command "_.UNDO" "_END")
(setvar "cmdecho" HOLDECHO)
(princ)
)
(prompt "\nType Trim_remain,By LUCAS(龍龍仔)")
(princ)

;;By LUCAS(龍龍仔) 
;;這是最初版本,錯漏百出,供你參考! 
;;後來程序越來越難看,不便貼出. 
;;(*polyline & spline---閉合&首尾點重合沒有弄好)  8-( 
 
;;線類思路 
;;1.在trim後，先取出想要的(1~2個點)，再undo 
;;2.計算trim後線長度,用lengthen調整線長 
 
;;圓、橢圓思路 
;;1.正常trim圓、橢圓 
;;2.修改端點(交換) 
 
(defun C:TRIM_REMAIN (/              DATA50  DATA51  ENT     ENTT    ENTTT 
                      HOLDECHO              LEND    LENT    LSTART  PT10 
                      PT11    SS      TYP     E42 
                     ) 
  (vl-load-com) 
  (defun DO_IT () 
    (if        (member        PT11 
                (list (vlax-curve-getstartpoint ENTT) 
                      (vlax-curve-getendpoint ENTT) 
                ) 
        ) 
      (command "_.undo" 
               1 
               "_.lengthen" 
               "de" 
               (- LSTART) 
               (list (car ENT) PT11) 
               "" 
 
      ) 
      (command "_.undo" 
               1 
               "_.lengthen" 
               "de" 
               (- LSTART) 
               (list (car ENT) PT10) 
               "" 
      ) 
    ) 
  ) 
  (setq HOLDECHO (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command "_.UNDO" "_GROUP") 
  (while 
    (and (setq 
           ENT (entsel "\n選取保留段: ") 
         ) 
         (setq TYP (cdr (assoc 0 (entget (car ENT))))) 
         (wcmatch TYP "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE") 
    ) 
 
     (if (wcmatch TYP "ELLIPSE") 
       (setq E42 (cdr (assoc 42 (entget (car ENT))))) 
     ) 
     (setq ENTT (vlax-ename->vla-object (car ENT))) 
     (setq PT10        (vlax-curve-getstartpoint ENTT) 
           PT11        (vlax-curve-getendpoint ENTT) 
     ) 
     (setq LENT (entlast)) 
     (command "_.select" "all" "r" (car ENT) "") 
     (setq SS (ssget "p")) 
     (command "_.trim" "l" "" "p" "n" "e" "n" "" "_.trim" SS ""        ENT "") 
     (if (wcmatch (cdr (assoc 0 (entget (entlast)))) 
                  "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE" 
         ) 
       (setq LEND (vlax-curve-getdistatparam 
                    (setq ENTTT (vlax-ename->vla-object (entlast))) 
                    (vlax-curve-getendparam ENTTT) 
                  ) 
       ) 
     ) 
     (cond 
       ((and (wcmatch TYP "POLYLINE") 
             (not (equal LENT (entlast))) 
        ) 
        (setq LSTART 
               (vlax-curve-getdistatparam 
                 (setq ENTT (vlax-ename->vla-object (entnext LENT))) 
                 (vlax-curve-getendparam ENTT) 
               ) 
        ) 
        (if (not (equal (entnext LENT) (entlast))) 
          (command "_.undo" 
                   1 
                   "_.lengthen" 
                   "de" 
                   (- LSTART) 
                   (list (car ENT) PT10) 
                   "" 
                   "_.lengthen" 
                   "de" 
                   (- LEND) 
                   (list (entlast) PT11) 
                   "" 
          ) 
          (DO_IT) 
        ) 
       ) 
       ((wcmatch TYP "CIRCLE") 
        (setq ENT 
               (entget (ssname (ssget "X" 
                                      (list (cons 0 "ARC") 
                                            (assoc 10 (entget (car ENT))) 
                                      ) 
                               ) 
                               0 
                       ) 
               ) 
        ) 
        (setq DATA50 (cdr (assoc 50 ENT))) 
        (setq DATA51 (cdr (assoc 51 ENT))) 
        (setq ENT (vl-remove (assoc 50 ENT) ENT)) 
        (setq ENT (vl-remove (assoc 51 ENT) ENT)) 
        (setq 
          ENT (append ENT (list (cons 50 DATA51) (cons 51 DATA50))) 
        ) 
        (entmod ENT) 
        (command "_.move" (cdr (assoc -1 ENT)) "" "0,0" "@") 
       ) 
       ((and (wcmatch TYP "ELLIPSE") 
             (equal E42 6.28318530717 0.00000000001) 
        ) 
        (setq ENT 
               (entget (ssname (ssget "X" 
                                      (list (cons 0 "ELLIPSE") 
                                            (assoc 10 (entget (car ENT))) 
                                      ) 
                               ) 
                               0 
                       ) 
               ) 
        ) 
        (setq DATA50 (cdr (assoc 41 ENT))) 
        (setq DATA51 (cdr (assoc 42 ENT))) 
        (setq ENT (vl-remove (assoc 41 ENT) ENT)) 
        (setq ENT (vl-remove (assoc 42 ENT) ENT)) 
        (setq 
          ENT (append ENT (list (cons 41 DATA51) (cons 42 DATA50))) 
        ) 
        (entmod ENT) 
        (command "_.move" (cdr (assoc -1 ENT)) "" "0,0" "@") 
       ) 
       (t 
        (setq LSTART (vlax-curve-getdistatparam 
                       ENTT 
                       (vlax-curve-getendparam ENTT) 
                     ) 
        ) 
        (if (not (equal (entlast) LENT)) 
          (command "_.undo" 
                   1 
                   "_.lengthen" 
                   "de" 
                   (- LSTART) 
                   (list (car ENT) PT10) 
                   "" 
                   "_.lengthen" 
                   "de" 
                   (- LEND) 
                   (list (car ENT) PT11) 
                   "" 
          ) 
          (DO_IT) 
        ) 
       ) 
     ) 
  ) 
  (command "_.UNDO" "_END") 
  (setvar "cmdecho" HOLDECHO) 
  (princ) 
) 
(prompt "\nType Trim_remain,By LUCAS(龍龍仔)") 
(princ)

狂刀 · 发表于 2005-3-24 17:19:29

试了一下.
lucas你的程序对封闭多义线,spline失效. 应该是用了length的原因,除非采取别的办法.
但对圆和椭圆效果还是比较令人满意的
aeo的可能问题多一些.
首先,一开始不应该确定选集,因为剪切后会形成新的实体,且应成为下一次剪切的边界,一开始确定选集无法有实时效果.
对封闭曲线还不能有效处理.
对开口的椭圆有bug
大家继续改进啊,

aeo · 发表于 2005-3-25 01:07:23

最初由狂刀发布
[B]试了一下.
lucas你的程序对封闭多义线,spline失效. 应该是用了length的原因,除非采取别的办法.
但对圆和椭圆效果还是比较令人满意的
aeo的可能问题多一些.
首先,一开始不应该确定选集,因为剪切后会形成新的实体,... [/B]

你不要在那里瞎掰了
你的cad的trim不是先选东西的(不选才奇怪，测试的时候感觉越简单越好，实际运用不是那么回事）
自己trim掉自己后，cad还亮显?

新生成的加入边界，其实是很简单，我特意把它去掉的.(检测一下而已，就是速度会慢一点:边界比较多的情况.)

开口的椭圆有时候是出错?什么状态?

封闭曲线?

你到底测试了没有?

aeo · 发表于 2005-3-25 01:19:42

"aeo的可能问题多一些."

肯定是没测试！

我刚想了个方法，估计十几行代码可以搞定.

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：一次点击保留中段（剪去两端）线怎么实现？

浏览过的版块