欲海猛男 发表于 2010-11-14 18:01:00

[求助]如何实现这个功能?

<p>这个简单啊</p>

xiaxiang 发表于 2010-12-14 16:50:17

估计一个也没发

zfen 发表于 2011-3-18 14:49:48

下载了xyp的修理墙角可是用不了,也希望楼主可以发一份给我
312958411@qq.com

357785513 发表于 2011-3-22 11:57:28

强悍,可以给咱也发一个不,兄台
357785519@163.COM

pizg 发表于 2011-5-5 19:42:38

只聞雷聲~~不見雨點.....
那些高人怎不發源代碼共享一下?

timmy521 发表于 2011-5-6 08:08:50

呵呵,只有想不到的,没有做不到的啊,

saiko008 发表于 2011-5-6 10:59:00

我也想要~~~~~~~~

【KAIXIN】 发表于 2011-12-10 19:53:48

下面是我以前收藏的一个东东,忘了出处,共享:;#字线段修剪
(defun l_layer( / i lyname sat)      ;去掉被锁住的层上的实体
   (setq i 0)
   (while (< i (sslength ul))
   (setq lyname nil)
   (setq sat nil)
   (setq lyname (cdr (assoc 8 (entget (ssname ul i)))))
   (setq sat(cdr (assoc 70 (tblsearch "layer" lyname))))
   (if (eq 68 sat)
       (progn
         (ssdel (ssname ul i) ul)
         (setq i (- i 1))
       )
   )
   (setq i (1+ i))
   )               
)

(defun ver_line( / i uu ln)      ;检查实体是否是直线
   (setq i 0)
   (setq uu(ssadd))
   (while (< i (sslength ul))
   (setq ln(ssname ul i))
   (if (= "LINE" (cdr(assoc 0(entget ln))))
       (ssadd ln uu)
   )
   (setq i(1+ i))
   )
   (setq ul uu)
)


(defun pplayer(ull / i lynameuul)         ;仅在"BEAM"层上的实体被选
   (setq i 0)
   (while (< i (sslength ull))
   (setq lyname (cdr (assoc 8 (entget (ssname ull i)))))
   (if (/= "BEAM" lyname)
       (progn
         (ssdel (ssname ull i) ull)
         (setq i (- i 1))
       )
   )
   (setq i (1+ i))
   )               
   (setq uul ull)
)


(defun in_w(tul sp ep / spu epu ppu pp ang il sett seet pt1x pt1y pt2x pt2y
                     pt1xu pt1yu pt1xuu pt1yuu pt2xu pt2yu pt2xuu pt2yuu
                     ppxu ppyu epxu epyu ptt1 ptt2)
                     
   (setq entb nil)
   (setq spu(trans sp 1 0 0))
   (setq epu(trans ep 1 0 0))
   (if (and (> (cadr epu) (cadr spu)) (> (car epu) (car spu)))
      (setq ppu (list (car epu) (cadr spu) (caddr spu)))
   )   
   (if (and (> (cadr epu) (cadr spu)) (< (car epu) (car spu)))
      (setq ppu (list (car spu) (cadr epu) (caddr spu)))
   )   
   (if (and (< (cadr epu) (cadr spu)) (> (car epu) (car spu)))
      (setq ppu (list (car spu) (cadr epu) (caddr spu)))
   )   
   (if (and (< (cadr epu) (cadr spu)) (< (car epu) (car spu)))
      (setq ppu (list (car epu) (cadr spu) (caddr spu)))
   )   
   (setq pp(trans ppu 0 1 0))
   (setq ang (angle sp pp))
   (setq il 0)
   (setq sett (ssadd))
   (setq seet nil)
   (while (< il (sslength tul))
   (setq pt1x (car(cdr(assoc 10 (entget(ssname ul il))))))
   (setq pt1y (cadr(cdr(assoc 10(entget(ssname ul il))))))
   (setq pt2x (car(cdr(assoc 11 (entget(ssname ul il))))))
   (setq pt2y (cadr(cdr(assoc 11(entget(ssname ul il))))))
   (setq ptt1(trans (list pt1x pt1y (caddr sp)) 0 1 0))
   (setq ptt2(trans (list pt2x pt2y (caddr sp)) 0 1 0))   
   (setq pt1xuu (car ptt1))               
   (setq pt1yuu (cadr ptt1))
   (setq pt2xuu (car ptt2))
   (setq pt2yuu (cadr ptt2))                           
   (setq pt1xu(+ (* (- pt1xuu (car sp)) (cos ang))
                   (* (- pt1yuu (cadr sp)) (sin ang))))   
   (setq pt1yu(- (* (- pt1yuu (cadr sp)) (cos ang))
                   (* (- pt1xuu (car sp)) (sin ang))))
   (setq pt2xu(+ (* (- pt2xuu (car sp)) (cos ang))
                   (* (- pt2yuu (cadr sp)) (sin ang))))
   (setq pt2yu(- (* (- pt2yuu (cadr sp)) (cos ang))
                   (* (- pt2xuu (car sp)) (sin ang))))
   (setq ppxu(+ (* (- (car pp) (car sp)) (cos ang))
                   (* (- (cadr pp) (cadr sp)) (sin ang))))
   (setq ppyu(- (* (- (cadr pp) (cadr sp)) (cos ang))
                   (* (- (car pp) (car sp)) (sin ang))))
   (setq epxu(+ (* (- (car ep) (car sp)) (cos ang))
                   (* (- (cadr ep) (cadr sp)) (sin ang))))
   (setq epyu(- (* (- (cadr ep) (cadr sp)) (cos ang))
                   (* (- (car ep) (car sp)) (sin ang))))
   (if (and (and (<= 0 pt1xu) (<= pt1xu ppxu))
            (and (<= 0 pt1yu) (<= pt1yu epyu)))
      (progn
         (ssadd (ssname tul il) sett)
         (setq entb (cons ptt1 entb))
         (setq entb (cons ptt2 entb))
      )
   )
   (if (and (and (<= 0 pt2xu) (<= pt2xu ppxu))
            (and (<= 0 pt2yu) (<= pt2yu epyu)))
      (progn
         (if (ssmemb (ssname tul il) sett)
            (progn
                (ssdel (ssname tul il) sett)
                ;(setq il (- il 1))
                (setq entb (cdr entb))
                (setq entb (cdr entb))
            )
            (progn
                (ssadd (ssname tul il) sett)
                (setq entb (cons ptt2 entb))
                (setq entb (cons ptt1 entb))
            )
         )
      )
   )
   (setq il (1+ il))
   )
   (setq entb (reverse entb))
   (setq seet sett) ;(exit)
)                  

(defun sub_set(sst1 sst2 / tt i set)
   (setq tt (sslength sst2))
   (setq i 0)
   (while (< i tt)
   (ssdel (ssname sst2 i) sst1 )
   (setq i (1+ i))   
   )
   (setq set sst1)
)
   

(defun int1( set2 / entn1 entn2 i ii pp1 pp2 p1 p2 it ptbb)
   (setq i 0)
   (setq newtb1 (ssadd))
   (setq ptb1 nil)            
   (while (< i (sslength set1))
   (setq entn1 (ssname set1 i))
   (setq pp1 (trans(cdr (assoc 10 (entget entn1))) 0 1 0))
   (setq pp2 (trans(cdr (assoc 11 (entget entn1))) 0 1 0))
   (setq ii 0)
   (setq it nil)
   (setq ptbb nil)
   (while (< ii (sslength set2))
       (setq entn2(ssname set2 ii))
       (setq p1 (trans(cdr (assoc 10 (entget entn2))) 0 1 0))
       (setq p2 (trans(cdr (assoc 11 (entget entn2))) 0 1 0))
       (setq it(inters pp1 pp2 p1 p2))
       (if it
         (setq ptbb(cons itptbb))
       )
       (setq ii (1+ ii))
   )                     
   (if (= 2 (length ptbb))
       (progn
         (ssadd entn1 newtb1)
         (setq ptb1(cons (nth 0 ptbb) ptb1))
         (setq ptb1(cons (nth 1 ptbb) ptb1))
       )
   )
   (setq i (1+ i))
   )
)

(defun int2( set2 / i ii l ptbb entn1 entn2 entnn it pp1 pp2 pt1 pt2
                  p1 p2)
   (setq i 0)
   (setq newtb2 (ssadd))
   (setq ptb2nil)
   (while (< i (sslength set2))
   (setq entn1(ssname set2i))
   (setq pt1 (trans(cdr (assoc 10 (entget entn1))) 0 1 0))
   (setq pt2 (trans(cdr (assoc 11 (entget entn1))) 0 1 0))
   (setq ii 0)
   (setq it nil)
   (setq ptbb nil)
   (while (< ii (sslength set1))
       (setq entn2(ssname set1 ii))
       (setq pp1 (trans(cdr (assoc 10 (entget entn2))) 0 1 0))
       (setq pp2 (trans(cdr (assoc 11 (entget entn2))) 0 1 0))
       (setq it(inters pt1 pt2 pp1 pp2))
       (if it
         (setq ptbb (cons it ptbb))
       )
       (setq ii (1+ ii))      
   )
   (if (and (> 3 (length ptbb)) (< 0 (length ptbb)))
       (progn
         (ssadd entn1 newtb2)
         (if (= 1 (length ptbb))
         (progn
             (setq pppp ptbb)
             (setq pppp (cons (nth (* 2 i) entb) pppp))
         )
         )
         (if (= 2 (length ptbb))
         (progn
             (setq pppp ptbb)
             (if (< (distance (nth 0 pppp) (nth (* 2 i) entb))
                  (distance (nth 1 pppp) (nth (* 2 i) entb)))
               (progn
               (setq pppp (list (nth 1 pppp) (nth (* 2 i) entb)))
               (setq l 0)                        
               (while (< l (sslength set1))
                   (setq entnn(ssname set1 l))
                   (setq p1(trans(cdr(assoc 10 (entget entnn))) 0 1 0))
                   (setq p2(trans(cdr(assoc 11 (entget entnn))) 0 1 0))
                   (if (> 0.0000001 (abs (- (angle (nth 0 ptbb) p1) (angle p2 p1))))
                     (progn
                     (ssdel entnn set1)
                     (setq l (- l 1))
                     )
                   )
                   (setq l (1+ l))
               )
               )
               (progn
               (setq pppp (list (nth 0 pppp) (nth (* 2 i) entb)))
               (setq l 0)
               (while (< l (sslength set1))
                   (setq entnn(ssname set1 l))
                   (setq p1(trans(cdr(assoc 10 (entget entnn))) 0 1 0))
                   (setq p2(trans(cdr(assoc 11 (entget entnn))) 0 1 0))
                   (if (> 0.0000001 (abs (- (angle (nth 1 ptbb) p1) (angle p2 p1))))
                     (progn
                     (ssdel entnn set1)
                     (setq l (- l 1))
                     )
                   )
                   (setq l (1+ l))
               )
               )
             )
         )
         )
         (setq ptb2 (cons (nth 0 pppp) ptb2))
         (setq ptb2 (cons (nth 1 pppp) ptb2))
       )
   )
   (setq i (1+ i))
   )   
   (setq ptb2(reverse ptb2))
)               

(defun int3(ul / i ii itt ptbb2 tp1 tp2 tp3 tp4 eet1 eet2 )
(setq i 0)   
(setq newtb1 (ssadd))
(setq ptb2 nil)
(while (< i (sslength ul))
    (setq eet1 (ssname ul i))
    (setq tp1 (trans(cdr (assoc 10(entget eet1))) 0 1 0))
    (setq tp2 (trans(cdr (assoc 11(entget eet1))) 0 1 0))
    (setq ii 0)
    (setq itt nil)
    (setq ptbb2 nil)
    (while (< ii (sslength ul))
      (setq eet2 (ssname ul ii))
      (setq tp3 (trans(cdr (assoc 10(entget eet2))) 0 1 0))
      (setq tp4 (trans(cdr (assoc 11(entget eet2))) 0 1 0))
      (setq itt(inters tp1 tp2 tp3 tp4))
      (if itt
      (setq ptbb2 (cons itt ptbb2))
      )
      (setq ii (1+ ii))
    )                        
    (if (= 2 (length ptbb2))
      (progn
      (setq ptb2(cons (nth 0 ptbb2) ptb2))
      (setq ptb2(cons (nth 1 ptbb2) ptb2))
      (ssadd eet1 newtb1)
      )
    )
    (setq i (1+ i))         
)
(setq ptb2 (reverse ptb2))   
)

(defun c:KK( / sp ep set1 entbtl i ptb1 ptb2 newtb1 newtb2 set
               stt cx_er cx_oe cx_oc gg ppp1 ppp2ul)
   (PRINC "\n【#字形线段修剪功能")
   (defun cx_er(msg)
   (if (/= msg "Function cancelled")
       (if (= msg "quit / exit abort")
         (princ)
         (princ (strcat "\n error :" msg))
       )
       (progn (setvar "osmode" gg) (princ))
   )
   (if cx_oe (setq *error* cx_oe))      
   (setvar "cmdecho" 0)
   (princ)
   )
   (if *error*
   (setq cx_oe *error* *error* cx_er)
   (setq *error* cx_er)
   )
   (setvar "CMDECHO" 0)
   (setq gg (getvar "osmode"))
   (setvar "osmode" 0)
   (setq sp (getpoint "\n-->请指定修剪的第一角点:"))
   (setq ep (getcorner sp "\n-->请指定修剪的对角点:"))
   (setvar "osmode" gg)
   ;(setq ul (ssadd))
   (setq set1 (ssadd))
   (setq ul (ssget "C" sp ep))   
   (if (not ul)
       (exit)
   )            
   (l_layer)   
   (ver_line)
   ;(setq ul (pplayer ul))
   (setq tl (in_w ul sp ep))         
   (if (/= 0 (sslength tl))
   (progn
       (setq set1(sub_set ul tl))   
       (int2 tl)   
       (int1 tl)   
       (setq i 0)         
       (while (< i (sslength newtb2))
         (ssadd (ssname newtb2 i) newtb1)
         (setq i (1+ i))
       )
       (setq ptb1 (reverse ptb1))
       (setq ptb2 (append ptb1 ptb2))
   )
   (int3 ul)
   )                     
   (if (/= 0 (sslength newtb1))
   (progn
       (setq i 0)
       (while (< i (sslength newtb1))
         (setq stt nil)
         (setq stt(ssadd))
         (ssadd (ssname newtb1 i) stt)
         (setq ppp1 (nth (* 2 i) ptb2))
         (setq ppp2(nth (+ 1 (* 2 i)) ptb2))
         (command "break"stt ppp1 ppp2)
         (setq i (1+ i))
       )
   )
   )
   (PRINC "\n#字形线段修剪完成!")(PRINC))

raimo 发表于 2011-12-10 20:24:08

楼上这个不太好用,仅适用于 双十字交叉的情况, 三岔路口就不行

yjr111 发表于 2011-12-12 01:56:12

对好东西总忍不住要模仿。。。。。。


页: 1 2 3 4 5 [6] 7 8 9
查看完整版本: 修剪十字交叉线段