设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 修剪十字交叉线段
123456789下一页
返回列表 发新帖
楼主: ljfei82050

修剪十字交叉线段

    [复制链接]
欲海猛男
发表于 2010-11-14 18:01:00 | 显示全部楼层

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

这个简单啊

回复 支持 反对

使用道具 举报

xiaxiang
发表于 2010-12-14 16:50:17 | 显示全部楼层
估计一个也没发

点评

yjr111
这个你有没有搞定？发一份给我  发表于 2011-12-11 00:35
回复 支持 反对

使用道具 举报

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 | 显示全部楼层
下面是我以前收藏的一个东东，忘了出处，共享：
  2. ;#字线段修剪
  3. (defun l_layer( / i lyname sat)      ;去掉被锁住的层上的实体
  4.    (setq i 0)
  5.    (while (< i (sslength ul))
  6.      (setq lyname nil)
  7.      (setq sat nil)
  8.      (setq lyname (cdr (assoc 8 (entget (ssname ul i)))))
  9.      (setq sat(cdr (assoc 70 (tblsearch "layer" lyname))))
  10.      (if (eq 68 sat)
  11.        (progn
  12.          (ssdel (ssname ul i) ul)
  13.          (setq i (- i 1))
  14.        )
  15.      )
  16.      (setq i (1+ i))
  17.    )               
  18. )

  20. (defun ver_line( / i uu ln)        ;检查实体是否是直线
  21.    (setq i 0)
  22.    (setq uu(ssadd))
  23.    (while (< i (sslength ul))
  24.      (setq ln(ssname ul i))
  25.      (if (= "LINE" (cdr(assoc 0(entget ln))))
  26.        (ssadd ln uu)
  27.      )
  28.      (setq i(1+ i))
  29.    )
  30.    (setq ul uu)
  31. )


  34. (defun pplayer(ull / i lyname  uul)         ;仅在"BEAM"层上的实体被选
  35.    (setq i 0)
  36.    (while (< i (sslength ull))
  37.      (setq lyname (cdr (assoc 8 (entget (ssname ull i)))))
  38.      (if (/= "BEAM" lyname)
  39.        (progn
  40.          (ssdel (ssname ull i) ull)
  41.          (setq i (- i 1))
  42.        )
  43.      )
  44.      (setq i (1+ i))
  45.    )               
  46.    (setq uul ull)
  47. )


  50. (defun in_w(tul sp ep / spu epu ppu pp ang il sett seet pt1x pt1y pt2x pt2y
  51.                        pt1xu pt1yu pt1xuu pt1yuu pt2xu pt2yu pt2xuu pt2yuu
  52.                        ppxu ppyu epxu epyu ptt1 ptt2)
  53.                      
  54.    (setq entb nil)  
  55.    (setq spu(trans sp 1 0 0))
  56.    (setq epu(trans ep 1 0 0))
  57.    (if (and (> (cadr epu) (cadr spu)) (> (car epu) (car spu)))
  58.       (setq ppu (list (car epu) (cadr spu) (caddr spu)))
  59.    )   
  60.    (if (and (> (cadr epu) (cadr spu)) (< (car epu) (car spu)))
  61.       (setq ppu (list (car spu) (cadr epu) (caddr spu)))
  62.    )   
  63.    (if (and (< (cadr epu) (cadr spu)) (> (car epu) (car spu)))
  64.       (setq ppu (list (car spu) (cadr epu) (caddr spu)))
  65.    )   
  66.    (if (and (< (cadr epu) (cadr spu)) (< (car epu) (car spu)))
  67.       (setq ppu (list (car epu) (cadr spu) (caddr spu)))
  68.    )   
  69.    (setq pp(trans ppu 0 1 0))  
  70.    (setq ang (angle sp pp))
  71.    (setq il 0)
  72.    (setq sett (ssadd))
  73.    (setq seet nil)
  74.    (while (< il (sslength tul))
  75.      (setq pt1x (car(cdr(assoc 10 (entget(ssname ul il))))))
  76.      (setq pt1y (cadr(cdr(assoc 10(entget(ssname ul il))))))
  77.      (setq pt2x (car(cdr(assoc 11 (entget(ssname ul il))))))
  78.      (setq pt2y (cadr(cdr(assoc 11(entget(ssname ul il))))))
  79.      (setq ptt1(trans (list pt1x pt1y (caddr sp)) 0 1 0))  
  80.      (setq ptt2(trans (list pt2x pt2y (caddr sp)) 0 1 0))   
  81.      (setq pt1xuu (car ptt1))                 
  82.      (setq pt1yuu (cadr ptt1))
  83.      (setq pt2xuu (car ptt2))
  84.      (setq pt2yuu (cadr ptt2))                           
  85.      (setq pt1xu(+ (* (- pt1xuu (car sp)) (cos ang))
  86.                    (* (- pt1yuu (cadr sp)) (sin ang))))   
  87.      (setq pt1yu(- (* (- pt1yuu (cadr sp)) (cos ang))
  88.                    (* (- pt1xuu (car sp)) (sin ang))))
  89.      (setq pt2xu(+ (* (- pt2xuu (car sp)) (cos ang))
  90.                    (* (- pt2yuu (cadr sp)) (sin ang))))
  91.      (setq pt2yu(- (* (- pt2yuu (cadr sp)) (cos ang))
  92.                    (* (- pt2xuu (car sp)) (sin ang))))
  93.      (setq ppxu(+ (* (- (car pp) (car sp)) (cos ang))
  94.                    (* (- (cadr pp) (cadr sp)) (sin ang))))
  95.      (setq ppyu(- (* (- (cadr pp) (cadr sp)) (cos ang))
  96.                    (* (- (car pp) (car sp)) (sin ang))))
  97.      (setq epxu(+ (* (- (car ep) (car sp)) (cos ang))
  98.                    (* (- (cadr ep) (cadr sp)) (sin ang))))
  99.      (setq epyu(- (* (- (cadr ep) (cadr sp)) (cos ang))
  100.                    (* (- (car ep) (car sp)) (sin ang))))
  101.      (if (and (and (<= 0 pt1xu) (<= pt1xu ppxu))
  102.               (and (<= 0 pt1yu) (<= pt1yu epyu)))
  103.         (progn
  104.            (ssadd (ssname tul il) sett)
  105.            (setq entb (cons ptt1 entb))
  106.            (setq entb (cons ptt2 entb))
  107.         )
  108.      )
  109.      (if (and (and (<= 0 pt2xu) (<= pt2xu ppxu))
  110.               (and (<= 0 pt2yu) (<= pt2yu epyu)))
  111.         (progn
  112.            (if (ssmemb (ssname tul il) sett)
  113.               (progn
  114.                 (ssdel (ssname tul il) sett)
  115.                 ;(setq il (- il 1))
  116.                 (setq entb (cdr entb))
  117.                 (setq entb (cdr entb))
  118.               )
  119.               (progn
  120.                 (ssadd (ssname tul il) sett)
  121.                 (setq entb (cons ptt2 entb))
  122.                 (setq entb (cons ptt1 entb))
  123.               )
  124.            )
  125.         )
  126.      )
  127.      (setq il (1+ il))
  128.    )
  129.    (setq entb (reverse entb))
  130.    (setq seet sett) ;(exit)
  131. )                  

  133. (defun sub_set(sst1 sst2 / tt i set)
  134.    (setq tt (sslength sst2))
  135.    (setq i 0)
  136.    (while (< i tt)
  137.      (ssdel (ssname sst2 i) sst1 )
  138.      (setq i (1+ i))     
  139.    )  
  140.    (setq set sst1)  
  141. )
  142.    

  144. (defun int1( set2 / entn1 entn2 i ii pp1 pp2 p1 p2 it ptbb)
  145.    (setq i 0)
  146.    (setq newtb1 (ssadd))
  147.    (setq ptb1 nil)            
  148.    (while (< i (sslength set1))
  149.      (setq entn1 (ssname set1 i))
  150.      (setq pp1 (trans(cdr (assoc 10 (entget entn1))) 0 1 0))
  151.      (setq pp2 (trans(cdr (assoc 11 (entget entn1))) 0 1 0))
  152.      (setq ii 0)
  153.      (setq it nil)
  154.      (setq ptbb nil)
  155.      (while (< ii (sslength set2))
  156.        (setq entn2(ssname set2 ii))
  157.        (setq p1 (trans(cdr (assoc 10 (entget entn2))) 0 1 0))
  158.        (setq p2 (trans(cdr (assoc 11 (entget entn2))) 0 1 0))
  159.        (setq it(inters pp1 pp2 p1 p2))
  160.        (if it
  161.          (setq ptbb(cons it  ptbb))
  162.        )
  163.        (setq ii (1+ ii))
  164.      )                       
  165.      (if (= 2 (length ptbb))
  166.        (progn
  167.          (ssadd entn1 newtb1)
  168.          (setq ptb1(cons (nth 0 ptbb) ptb1))
  169.          (setq ptb1(cons (nth 1 ptbb) ptb1))
  170.        )
  171.      )
  172.      (setq i (1+ i))
  173.    )
  174. )

  176. (defun int2( set2 / i ii l ptbb entn1 entn2 entnn it pp1 pp2 pt1 pt2
  177.                     p1 p2)
  178.    (setq i 0)
  179.    (setq newtb2 (ssadd))
  180.    (setq ptb2  nil)
  181.    (while (< i (sslength set2))
  182.      (setq entn1(ssname set2  i))
  183.      (setq pt1 (trans(cdr (assoc 10 (entget entn1))) 0 1 0))
  184.      (setq pt2 (trans(cdr (assoc 11 (entget entn1))) 0 1 0))
  185.      (setq ii 0)
  186.      (setq it nil)
  187.      (setq ptbb nil)
  188.      (while (< ii (sslength set1))
  189.        (setq entn2(ssname set1 ii))
  190.        (setq pp1 (trans(cdr (assoc 10 (entget entn2))) 0 1 0))
  191.        (setq pp2 (trans(cdr (assoc 11 (entget entn2))) 0 1 0))
  192.        (setq it(inters pt1 pt2 pp1 pp2))
  193.        (if it
  194.          (setq ptbb (cons it ptbb))
  195.        )
  196.        (setq ii (1+ ii))      
  197.      )
  198.      (if (and (> 3 (length ptbb)) (< 0 (length ptbb)))
  199.        (progn
  200.          (ssadd entn1 newtb2)
  201.          (if (= 1 (length ptbb))
  202.            (progn
  203.              (setq pppp ptbb)
  204.              (setq pppp (cons (nth (* 2 i) entb) pppp))
  205.            )
  206.          )
  207.          (if (= 2 (length ptbb))
  208.            (progn
  209.              (setq pppp ptbb)
  210.              (if (< (distance (nth 0 pppp) (nth (* 2 i) entb))
  211.                     (distance (nth 1 pppp) (nth (* 2 i) entb)))
  212.                (progn
  213.                  (setq pppp (list (nth 1 pppp) (nth (* 2 i) entb)))
  214.                  (setq l 0)                        
  215.                  (while (< l (sslength set1))
  216.                    (setq entnn(ssname set1 l))
  217.                    (setq p1(trans(cdr(assoc 10 (entget entnn))) 0 1 0))
  218.                    (setq p2(trans(cdr(assoc 11 (entget entnn))) 0 1 0))
  219.                    (if (> 0.0000001 (abs (- (angle (nth 0 ptbb) p1) (angle p2 p1))))
  220.                      (progn
  221.                        (ssdel entnn set1)
  222.                        (setq l (- l 1))
  223.                      )
  224.                    )
  225.                    (setq l (1+ l))
  226.                  )
  227.                )
  228.                (progn
  229.                  (setq pppp (list (nth 0 pppp) (nth (* 2 i) entb)))
  230.                  (setq l 0)
  231.                  (while (< l (sslength set1))
  232.                    (setq entnn(ssname set1 l))
  233.                    (setq p1(trans(cdr(assoc 10 (entget entnn))) 0 1 0))
  234.                    (setq p2(trans(cdr(assoc 11 (entget entnn))) 0 1 0))
  235.                    (if (> 0.0000001 (abs (- (angle (nth 1 ptbb) p1) (angle p2 p1))))
  236.                      (progn
  237.                        (ssdel entnn set1)
  238.                        (setq l (- l 1))
  239.                      )
  240.                    )
  241.                    (setq l (1+ l))
  242.                  )
  243.                )
  244.              )
  245.            )
  246.          )
  247.          (setq ptb2 (cons (nth 0 pppp) ptb2))
  248.          (setq ptb2 (cons (nth 1 pppp) ptb2))
  249.        )
  250.      )
  251.      (setq i (1+ i))
  252.    )     
  253.    (setq ptb2(reverse ptb2))
  254. )               

  256. (defun int3(ul / i ii itt ptbb2 tp1 tp2 tp3 tp4 eet1 eet2 )
  257.   (setq i 0)   
  258.   (setq newtb1 (ssadd))
  259.   (setq ptb2 nil)
  260.   (while (< i (sslength ul))
  261.     (setq eet1 (ssname ul i))
  262.     (setq tp1 (trans(cdr (assoc 10(entget eet1))) 0 1 0))
  263.     (setq tp2 (trans(cdr (assoc 11(entget eet1))) 0 1 0))
  264.     (setq ii 0)
  265.     (setq itt nil)
  266.     (setq ptbb2 nil)
  267.     (while (< ii (sslength ul))
  268.       (setq eet2 (ssname ul ii))
  269.       (setq tp3 (trans(cdr (assoc 10(entget eet2))) 0 1 0))
  270.       (setq tp4 (trans(cdr (assoc 11(entget eet2))) 0 1 0))
  271.       (setq itt(inters tp1 tp2 tp3 tp4))  
  272.       (if itt
  273.         (setq ptbb2 (cons itt ptbb2))
  274.       )
  275.       (setq ii (1+ ii))
  276.     )                        
  277.     (if (= 2 (length ptbb2))
  278.       (progn
  279.         (setq ptb2(cons (nth 0 ptbb2) ptb2))
  280.         (setq ptb2(cons (nth 1 ptbb2) ptb2))
  281.         (ssadd eet1 newtb1)
  282.       )
  283.     )
  284.     (setq i (1+ i))           
  285.   )  
  286.   (setq ptb2 (reverse ptb2))   
  287. )  

  289. (defun c:KK( / sp ep set1 entb  tl i ptb1 ptb2 newtb1 newtb2 set
  290.                  stt cx_er cx_oe cx_oc gg ppp1 ppp2  ul)
  291.      (PRINC "\n【#字形线段修剪功能")
  292.    (defun cx_er(msg)
  293.      (if (/= msg "Function cancelled")
  294.        (if (= msg "quit / exit abort")
  295.          (princ)  
  296.          (princ (strcat "\n error :" msg))
  297.        )
  298.        (progn (setvar "osmode" gg) (princ))
  299.      )
  300.      (if cx_oe (setq *error* cx_oe))        
  301.      (setvar "cmdecho" 0)
  302.      (princ)
  303.    )
  304.    (if *error*
  305.      (setq cx_oe *error* *error* cx_er)
  306.      (setq *error* cx_er)
  307.    )
  308.    (setvar "CMDECHO" 0)
  309.    (setq gg (getvar "osmode"))
  310.    (setvar "osmode" 0)
  311.    (setq sp (getpoint "\n-->请指定修剪的第一角点："))
  312.    (setq ep (getcorner sp "\n-->请指定修剪的对角点："))
  313.    (setvar "osmode" gg)
  314.    ;(setq ul (ssadd))  
  315.    (setq set1 (ssadd))
  316.    (setq ul (ssget "C" sp ep))   
  317.    (if (not ul)
  318.        (exit)
  319.    )              
  320.    (l_layer)   
  321.    (ver_line)
  322.    ;(setq ul (pplayer ul))
  323.    (setq tl (in_w ul sp ep))         
  324.    (if (/= 0 (sslength tl))
  325.      (progn
  326.        (setq set1(sub_set ul tl))     
  327.        (int2 tl)     
  328.        (int1 tl)   
  329.        (setq i 0)           
  330.        (while (< i (sslength newtb2))
  331.          (ssadd (ssname newtb2 i) newtb1)
  332.          (setq i (1+ i))
  333.        )
  334.        (setq ptb1 (reverse ptb1))
  335.        (setq ptb2 (append ptb1 ptb2))
  336.      )
  337.      (int3 ul)
  338.    )                       
  339.    (if (/= 0 (sslength newtb1))
  340.      (progn
  341.        (setq i 0)
  342.        (while (< i (sslength newtb1))
  343.          (setq stt nil)
  344.          (setq stt(ssadd))
  345.          (ssadd (ssname newtb1 i) stt)
  346.          (setq ppp1 (nth (* 2 i) ptb2))
  347.          (setq ppp2(nth (+ 1 (* 2 i)) ptb2))
  348.          (command "break"stt ppp1 ppp2)
  349.          (setq i (1+ i))
  350.        )
  351.      )
  352.    )
  353.      (PRINC "\n#字形线段修剪完成！")(PRINC))
回复 支持 反对

使用道具 举报

raimo
发表于 2011-12-10 20:24:08 | 显示全部楼层
楼上这个不太好用，仅适用于 双十字交叉的情况， 三岔路口就不行
回复 支持 反对

使用道具 举报

yjr111
发表于 2011-12-12 01:56:12 | 显示全部楼层
对好东西总忍不住要模仿。。。。。。


本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

123456789下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-16 06:30 , Processed in 0.176837 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表