[求助]：編了個交點處打斷,有錯.請各位指點一下!

taner · 发表于 2006-1-21 08:29:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

編了個交點處打斷,有錯.請各位指點一下!

程序思路:
1.先求實體交點表.
2.對選擇集中的每個實體,看哪些點在這個實體上.
3.將在這個實體上的點進行按離起點的距離排序.(正方向)
4.先將離起點近的實體打斷.用entlast求得離起點較遠的部,再從離起點近的點開始打斷.

主程序:

[FONT=courier new]
(defun th-breakatintersec (ss / ename i j k l m n ptj ptlist ptlisti
ptlistmin2max ssnamei
)
(if (= ss nil)
(setq ss (ssget '((0 . "*LINE,ARC"))))
)
(if (setq ptlist (th2-ssinters ss))
(progn
(setq i -1
j -1
m (1- (sslength ss))
n (1- (length ptlist))
)
(while (< i m)
(setq ssnamei (ssname ss (setq i (1+ i))))
(setq ptlisti '())
(while (< j n)
(setq ptj (nth (setq j (1+ j))
ptlist
)
)
(if (vlax-curve-getdistatpoint ssnamei ptj)
(setq ptlisti (cons ptj ptlisti))
)
)
(if ptlisti
(progn
(setq ptlistmin2max (th-getnin2maxpts ssnamei ptlisti)
k 1
l (1- (length ptlistmin2max))
)
(while (< k l)
(command "break" ssnamei (nth (setq k (1+ k))
ptlistmin2max
) "@"
)
(setq ssnamei (entlast))
)
)
)
)
)
)
)
[/FONT]

[FONT=courier new] 
(defun th-breakatintersec (ss / ename i j k l m n ptj ptlist ptlisti 
                              ptlistmin2max ssnamei 
                          ) 
  (if (= ss nil) 
    (setq ss (ssget '((0 . "*LINE,ARC")))) 
  ) 
  (if (setq ptlist (th2-ssinters ss)) 
    (progn 
      (setq i -1 
            j -1 
            m (1- (sslength ss)) 
            n (1- (length ptlist)) 
      ) 
      (while (
        (setq ssnamei (ssname ss (setq i (1+ i)))) 
        (setq ptlisti '()) 
        (while (< j n) 
          (setq ptj (nth (setq j (1+ j)) 
                         ptlist 
                    ) 
          ) 
          (if (vlax-curve-getdistatpoint ssnamei ptj) 
            (setq ptlisti (cons ptj ptlisti)) 
          ) 
        ) 
        (if ptlisti 
          (progn 
            (setq ptlistmin2max (th-getnin2maxpts ssnamei ptlisti) 
                  k 1 
                  l (1- (length ptlistmin2max)) 
            ) 
            (while (< k l) 
              (command "break" ssnamei (nth (setq k (1+ k)) 
                                            ptlistmin2max 
                                       ) "@" 
              ) 
              (setq ssnamei (entlast)) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
  [/FONT]

求交點集子程序(函數庫裏有,改了個名):

[FONT=courier new]
(defun th2-ssinters (ss / ss ssl pts aobj1 aobj2
n1 n2 ipts a n nn
holdosmode
)
(vl-load-com)
(setq holdosmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (= nil ss)
(setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
)
(setq n1 0
ssl (sslength ss)
)
(while (< n1 (1- ssl))
(setq aobj1 (ssname ss n1)
aobj1 (vlax-ename->vla-object aobj1)
n2 (1+ n1)
)
(while (< n2 ssl)
(setq aobj2 (ssname ss n2)
aobj2 (vlax-ename->vla-object aobj2)
ipts (vla-intersectwith aobj1 aobj2 acextendnone)
ipts (vlax-variant-value ipts)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0)
(progn
(setq ipts (vlax-safearray->list ipts))
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts)
ipts (cdddr ipts)
)
)
)
)
(setq n2 (1+ n2))
)
(setq n1 (1+ n1))
)
(setvar "OSMODE" holdosmode)
pts
)
[/FONT]

[FONT=courier new] 
(defun th2-ssinters (ss            /           ss          ssl         pts        aobj1  aobj2 
                     n1            n2           ipts          a         n        nn 
                     holdosmode 
                    ) 
  (vl-load-com) 
  (setq holdosmode (getvar "OSMODE")) 
  (setvar "OSMODE" 0) 
  (if (= nil ss) 
    (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))) 
  ) 
  (setq        n1  0 
        ssl (sslength ss) 
  ) 
  (while (< n1 (1- ssl)) 
    (setq aobj1        (ssname ss n1) 
          aobj1        (vlax-ename->vla-object aobj1) 
          n2        (1+ n1) 
    ) 
    (while (< n2 ssl) 
      (setq aobj2 (ssname ss n2) 
            aobj2 (vlax-ename->vla-object aobj2) 
            ipts  (vla-intersectwith aobj1 aobj2 acextendnone) 
            ipts  (vlax-variant-value ipts) 
      ) 
      (if (> (vlax-safearray-get-u-bound ipts 1) 0) 
        (progn 
          (setq ipts (vlax-safearray->list ipts)) 
          (while (> (length ipts) 0) 
            (setq pts  (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts) 
                  ipts (cdddr ipts) 
            ) 
          ) 
        ) 
      ) 
      (setq n2 (1+ n2)) 
    ) 
    (setq n1 (1+ n1)) 
  ) 
  (setvar "OSMODE" holdosmode) 
  pts 
) 
  [/FONT]

子程序點集排序:
http://www.xdcad.net/forum/showthread.php?s=&threadid=518698

還有點問題
1.只能把第一實體打斷
2.對於閉合多義線,會將起點處打斷(本意只將交點打斷)

TYEEXDD · 发表于 2006-1-22 18:52:42

请问：你如何能确定用(entlast)得到的实体就是你的程序下一个要操作（打断）的对象？？？线条的起点终点方向不同都会有影响的！！自己试试。

taner · 发表于 2006-1-23 08:58:11

再修改,用eachy版主新編的函數.
運行還是有點問題.最外層的循環好象只能運行一次,即i=-1時運行,i=0時就不執行BREAK命令了.請高手幫忙看看.

[FONT=courier new]
(defun th-breakatintersec (ss / ename i j
k l m n ptj
ptlist ptlisti ptlistmin2max ssnamei
)
(if (= ss nil)
(setq ss (ssget '((0 . "*LINE,ARC"))))
) ; 如果選擇集不存在,重新選擇
(if (setq ptlist (th2-ssinters ss)) ; if1
(progn ; progn1
(setq i -1
j -1
m (1- (sslength ss))
n (1- (length ptlist))
)
(while (< i m) ; while ssname
(setq ssnamei (ssname ss (setq i (1+ i))))
(setq ptlisti '())
(while (< j n) ; while ptlist nth
(setq ptj (nth (setq j (1+ j))
ptlist
)
)
(if (vlax-curve-getdistatpoint ssnamei ptj) ; if2
(setq ptlisti (cons ptj ptlisti))
) ; end if2
) ; end while ptlist nth
(if ptlisti ; if3
(progn ; progn2
(setq ptlistmin2max (cadr (xdl-pts-sortonpl ssnamei ptlisti))
k -1
l (1- (length ptlistmin2max))
)
(while (< k l) ; while break
(command "break"
ssnamei
(nth (setq k (1+ k))
ptlistmin2max
)
"@"
)
(setq ssnamei (entlast))
) ; end while break
) ; end progn2
) ; end if3
) ; end while ssname
) ; end progn1
) ; end if1
)
[/FONT]

[FONT=courier new] 
(defun th-breakatintersec (ss           /           ename   i           j 
                           k           l           m           n           ptj 
                           ptlist  ptlisti ptlistmin2max   ssnamei 
                          ) 
  (if (= ss nil) 
    (setq ss (ssget '((0 . "*LINE,ARC")))) 
  )                                        ; 如果選擇集不存在,重新選擇 
  (if (setq ptlist (th2-ssinters ss))        ; if1 
    (progn                                ; progn1 
      (setq i -1 
            j -1 
            m (1- (sslength ss)) 
            n (1- (length ptlist)) 
      ) 
      (while (
        (setq ssnamei (ssname ss (setq i (1+ i)))) 
        (setq ptlisti '()) 
        (while (< j n)                        ; while ptlist nth 
          (setq        ptj (nth (setq j (1+ j)) 
                         ptlist 
                    ) 
          ) 
          (if (vlax-curve-getdistatpoint ssnamei ptj) ; if2 
            (setq ptlisti (cons ptj ptlisti)) 
          )                                ; end if2 
        )                                ; end while ptlist nth 
        (if ptlisti                        ; if3 
          (progn                        ; progn2 
            (setq ptlistmin2max        (cadr (xdl-pts-sortonpl ssnamei ptlisti)) 
                  k                -1 
                  l                (1- (length ptlistmin2max)) 
            ) 
            (while (< k l)                ; while break 
              (command "break" 
                       ssnamei 
                       (nth (setq k (1+ k)) 
                            ptlistmin2max 
                       ) 
                       "@" 
              ) 
              (setq ssnamei (entlast)) 
            )                                ; end while break 
          )                                ; end progn2 
        )                                ; end if3 
      )                                        ; end while ssname 
    )                                        ; end progn1 
  )                                        ; end if1 
 
) 
 
  [/FONT]

xyp1964 · 发表于 2006-1-23 19:57:48

[php]最好把函数放到一起，形成完整的链，否则有点看不懂！
xdl-pts-sortonpl 函数未定义？！无法继续测试。[/php]

以下尚未完成，暂把所有函数放到一处！

[FONT=courier new]
(defun c:test ()
(CMDLA0)
(setvar "OSMODE" 0)
(if (setq ss (ssget '((0 . "*LINE,ARC"))))
(th-breakatintersec ss)
)
(CMDLA1)
)
;;;交點處打斷
(defun th-breakatintersec (ss / ename i j
k l m n ptj
ptlist ptlisti ptlistmin2max ssnamei
)
(if (setq ptlist (th2-ssinters ss))
(progn
(setq i -1
j -1
m (1- (sslength ss))
n (1- (length ptlist))
ptlisti '()
)
(while (< i m)
(setq ssnamei (ssname ss (setq i (1+ i)))
;ptlisti '()
)
(while (< j n)
(setq ptj (nth (setq j (1+ j))
ptlist
)
)
(if (vlax-curve-getdistatpoint ssnamei ptj)
(setq ptlisti (cons ptj ptlisti))
)
)
(if ptlisti
(progn
(setq ptlistmin2max (cadr (xdl-pts-sortonpl ssnamei ptlisti))
k -1
l (1- (length ptlistmin2max))
)
(while (< k l)
(command "break"
ssnamei
(nth (setq k (1+ k))
ptlistmin2max
)
"@"
)
(setq ssnamei (entlast))
)
)
)
)
)
)
)
;;;求交點集子程序
(defun th2-ssinters (ss / ssl pts aobj1 aobj2 n1 n2 ipts a n nn
holdosmode)
(setq n1 0
ssl (sslength ss)
)
(while (< n1 (1- ssl))
(setq aobj1 (ssname ss n1)
aobj1 (vlax-ename->vla-object aobj1)
n2 (1+ n1)
)
(while (< n2 ssl)
(setq aobj2 (ssname ss n2)
aobj2 (vlax-ename->vla-object aobj2)
ipts (vla-intersectwith aobj1 aobj2 acextendnone)
ipts (vlax-variant-value ipts)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0)
(progn
(setq ipts (vlax-safearray->list ipts))
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts)
ipts (cdddr ipts)
)
)
)
)
(setq n2 (1+ n2))
)
(setq n1 (1+ n1))
)
pts
)
;;点集按Pl起点到终点排序，返回(pline实体排序后的点表)
(defun xdl-pts-sortonpl (pl pts)
(setq pts (mapcar
'(lambda (x)
(list (vlax-curve-getdistatpoint
pl
(vlax-curve-getclosestpointto pl x)
)
x
)
)
pts
)
pts (vl-sort pts
'(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
(list pl
(mapcar
'cadr
pts
)
)
)[/FONT]

[FONT=courier new] 
(defun c:test () 
  (CMDLA0) 
  (setvar "OSMODE" 0) 
  (if (setq ss (ssget '((0 . "*LINE,ARC")))) 
    (th-breakatintersec ss) 
  ) 
  (CMDLA1) 
) 
 
;;;交點處打斷 
(defun th-breakatintersec (ss           /           ename   i           j 
                           k           l           m           n           ptj 
                           ptlist  ptlisti ptlistmin2max   ssnamei 
                          ) 
  (if (setq ptlist (th2-ssinters ss)) 
    (progn 
      (setq i            -1 
            j            -1 
            m            (1- (sslength ss)) 
            n            (1- (length ptlist)) 
            ptlisti '() 
      ) 
      (while (
        (setq ssnamei (ssname ss (setq i (1+ i))) 
                                        ;ptlisti '() 
        ) 
        (while (< j n) 
          (setq        ptj (nth (setq j (1+ j)) 
                         ptlist 
                    ) 
          ) 
          (if (vlax-curve-getdistatpoint ssnamei ptj) 
            (setq ptlisti (cons ptj ptlisti)) 
          ) 
        ) 
        (if ptlisti 
          (progn 
            (setq ptlistmin2max        (cadr (xdl-pts-sortonpl ssnamei ptlisti)) 
                  k                -1 
                  l                (1- (length ptlistmin2max)) 
            ) 
            (while (< k l) 
              (command "break" 
                       ssnamei 
                       (nth (setq k (1+ k)) 
                            ptlistmin2max 
                       ) 
                       "@" 
              ) 
              (setq ssnamei (entlast)) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
;;;求交點集子程序 
(defun th2-ssinters (ss        / ssl pts aobj1        aobj2 n1 n2 ipts a n nn 
                     holdosmode) 
  (setq        n1  0 
        ssl (sslength ss) 
  ) 
  (while (< n1 (1- ssl)) 
    (setq aobj1        (ssname ss n1) 
          aobj1        (vlax-ename->vla-object aobj1) 
          n2        (1+ n1) 
    ) 
    (while (< n2 ssl) 
      (setq aobj2 (ssname ss n2) 
            aobj2 (vlax-ename->vla-object aobj2) 
            ipts  (vla-intersectwith aobj1 aobj2 acextendnone) 
            ipts  (vlax-variant-value ipts) 
      ) 
      (if (> (vlax-safearray-get-u-bound ipts 1) 0) 
        (progn 
          (setq ipts (vlax-safearray->list ipts)) 
          (while (> (length ipts) 0) 
            (setq pts  (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts) 
                  ipts (cdddr ipts) 
            ) 
          ) 
        ) 
      ) 
      (setq n2 (1+ n2)) 
    ) 
    (setq n1 (1+ n1)) 
  ) 
  pts 
) 
 
;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表) 
(defun xdl-pts-sortonpl        (pl pts) 
  (setq        pts (mapcar 
              '(lambda (x) 
                 (list (vlax-curve-getdistatpoint 
                         pl 
                         (vlax-curve-getclosestpointto pl x) 
                       ) 
                       x 
                 ) 
               ) 
              pts 
            ) 
        pts (vl-sort pts 
                     '(lambda (e1 e2) 
                        (< (car e1) (car e2)) 
                      ) 
            ) 
  ) 
  (list        pl 
        (mapcar 
          'cadr 
          pts 
        ) 
  ) 
)[/FONT]

测试结果太怪！
程序较长，一时看不懂！
还是偶的(xyp-break(ssget))比较方便，卖瓜了！呵呵……

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

[求助] [求助]：編了個交點處打斷,有錯.請各位指點一下!

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子