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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [wkq004]按多边形范围裁切,裁内,裁外,裁搭界...
12下一页
返回列表 发新帖
查看: 3215|回复: 10

[wkq004]按多边形范围裁切,裁内,裁外,裁搭界...

[复制链接]
004
发表于 2012-12-20 23:23:27 | 显示全部楼层 |阅读模式
本帖最后由 004 于 2012-12-20 23:33 编辑

用"裁切"搜索论坛相关的源码仅有3篇,一片是 xgr 写的局部复制的,还有一篇是裁外的,是半成品,而最后一片是半成品的简化版.好惨啊,但事实就是这样.我写的这个仅实现了裁内,裁外两个功能,有时还会出错,请大侠指点,有能力了加强到仿MicroStation---fance的效果,那就完结了.
还有看到高手老说扩展的acet函数,但代码看着真晕,哪位大侠把学习这些源码的经历,分享下,要怎么学.
  1. (defun c:tt (/ AA E EL ELONG EN        EO EPTL        FX I LEN LST OLDBLIP OLDCMD OLDGROUP OLDPDMODE OLDSNAP OLONG
  2.              ONE PT PTL        PTLST PXMAX SS SSTEXT TEXT
  3.             )
  4.   ;;功能:选择范围和方向点,裁内或裁外
  5.   ;;局限:1.仅支持轻多段线范围,2.范围线不能打折
  6.   ;;日期:wkq004@qq.com修改 2012-12-20
  7.   ;;原程序来自明经通道by xgr 2007-8-30
  8.   (command ".undo" "e")
  9.   (command ".undo" "begin")
  10.   (setvar "LUPREC" 8)
  11.   (setq oldgroup (getvar "pickstyle"))        ;保存编组开关
  12.   (setvar "pickstyle" 0)                ;关闭编组
  13.   (setq oldcmd (getvar "cmdecho"))        ;保存控制 command 函数运行期间，AutoCAD 是否回显提示和输入
  14.   (setvar "cmdecho" 0)                        ;关闭command 函数运行期间，AutoCAD 回显提示和输入
  15.   (setq oldblip (getvar "blipmode"))        ;保存控制点标记
  16.   (setvar "blipmode" 0)                        ;关闭点标记
  17.   (setq oldpdmode (getvar "pdmode"))        ;关闭点样式
  18.   (setq oldsnap (getvar "osmode"))        ;保存对象捕捉方式
  19.   (setvar "osmode" 0)                        ;关闭对象捕捉式
  20.   (while (or (if (setq en (nentselp "\n选择作为剪切边界的闭合多段线:"))
  21.                nil
  22.                (setq ss "空选择!")
  23.              )
  24.              (if (= (cdr (assoc 0 (setq el (entget (setq e (car en)))))) "LWPOLYLINE")
  25.                nil
  26.                (setq ss "类型错误!")
  27.              )
  28.              (if (= (logand (cdr (assoc 70 el)) 1) 1)
  29.                nil
  30.                (setq ss "线段不闭合!")
  31.              )
  32.              (if (setq fx (getpoint "\n请选择裁切方向:"))
  33.                nil
  34.                (setq ss "选择裁切方向!")
  35.              )
  36.          )
  37.     (alert (strcat "选择错误-" ss ",重新选择!"))
  38.   )
  39.   (setq elong 0)
  40.   (setq eptl '())
  41.   (setq one (cdr (assoc 10 el)))
  42.   (foreach pt el
  43.     (if        (= 10 (car pt))
  44.       (setq pt          (cdr pt)
  45.             elong (+ elong (distance one pt))
  46.             one          pt
  47.             eptl  (cons pt eptl)
  48.       )
  49.     )
  50.   )
  51.   (print "\n正在剪切图形,请稍侯......")
  52.   (command ".offset" 0.1 e fx "");_原多段线上有重点,偏移后的线上应该没有重点吧?
  53.   (setq eo (entlast))
  54.   (setq el (entget eo))
  55.   (command ".erase" eo "")
  56.   (setq olong 0)
  57.   (setq ptl '())
  58.   (setq one (cdr (assoc 10 el)))
  59.   (foreach pt el
  60.     (if        (= 10 (car pt))
  61.       (setq pt          (cdr pt)
  62.             olong (+ olong (distance one pt))
  63.             one          pt
  64.             ptl          (cons pt ptl)
  65.       )
  66.     )
  67.   )
  68.   (setq pxmax (list (apply 'mapcar (cons 'min ptl)) (apply 'mapcar (cons 'max ptl))))
  69.   (command ".zoom" "w" (car pxmax) (cadr pxmax))
  70.   (setq ptl (append ptl (list (car ptl))))
  71.   ;;炸开相交的块,面域,填充图案
  72.   (setq i 0)
  73.   (while (and (setq ss (ssget "F" ptl '((0 . "INSERT,HATCH,REGION")))) (> 10000 (setq i (1+ i))))
  74.     (repeat (setq len (sslength ss)) (command ".EXPLODE" (ssname ss (setq len (1- len)))))
  75.   )
  76.   (setvar "pdmode" 0) ;_关闭点样式
  77.   (setq lst '())
  78.   (if (setq ss (ssget "f" ptl '((0 . "text,mtext"))))
  79.     (repeat (setq len (sslength ss))
  80.       (setq text (ssname ss (setq len (1- len))))
  81.       (setq pt (assoc 10 (entget text)))
  82.       (entmake (list '(0 . "point") pt))
  83.       (setq lst (cons (list (entlast) text) lst))
  84.     )
  85.   )
  86.   ;;偏移线的长度小于原线长度,裁内否则裁外
  87.   (if (< olong elong)
  88.     ;;裁内
  89.     (if        (setq ss (ssget "wp" eptl))
  90.       (command ".erase" ss "")
  91.     )
  92.     ;;裁外
  93.     (if        (setq ss (ssget "cp" eptl))
  94.       (command ".erase" "all" "r" ss "")
  95.     )
  96.   )
  97.   (foreach potx        lst
  98.     (if        (entget (car potx))
  99.       (entdel (car potx))
  100.       (entdel (cadr potx))
  101.     )
  102.   )
  103.   (repeat 3
  104.     (setq one (car ptl))
  105.     (foreach two (cdr ptl) (command ".trim" e "" "f" one two "" "") (setq one two))
  106.   )
  107.   ;;删除向内裁切矩形的对角线,考虑文本
  108.   ;;处理有宽度的多段线
  109.   (if (setq ss (ssget "cp"
  110.                       ptl
  111.                       '((-4 . "<NOT")
  112.                         (-4 . "<or")
  113.                         (0 . "text,mtext,INSERT,HATCH,REGION")
  114.                         (-4 . "<and")
  115.                         (0 . "lwpolyline,polyline")
  116.                         (-4 . "<or")
  117.                         (-4 . ">")
  118.                         (40 . 0.0)
  119.                         (-4 . ">")
  120.                         (41 . 0.0)
  121.                         (-4 . "or>")
  122.                         (-4 . "and>")
  123.                         (-4 . "or>")
  124.                         (-4 . "NOT>")
  125.                        )
  126.                )
  127.       )
  128.     (if (< olong elong)
  129.              ;;裁内
  130.              (command ".erase" ss "")
  131.              ;;裁外
  132.              (command ".erase" "all" "r" ss "")
  133.            )
  134.   )
  135.   (command "zoom" "p") ;_恢复视窗大小
  136.   (setvar "LUPREC" 8)
  137.   (setvar "pickstyle" oldgroup)
  138.   (setvar "cmdecho" oldcmd)
  139.   (setvar "blipmode" oldblip)
  140.   (setvar "pdmode" oldpdmode)
  141.   (setvar "osmode" oldsnap)
  142.   (command ".undo" "e")
  143.   (princ)
  144. )



本帖子中包含更多资源

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

x

点评

树櫴希德
好啊 004就像007  发表于 2015-12-1 09:32
kwok
超好,能支持多选更完美.  发表于 2012-12-21 15:50
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

zzc83
发表于 2012-12-21 07:35:28 | 显示全部楼层
本帖最后由 zzc83 于 2012-12-21 07:35 编辑

[资源] 求删除封闭多边形内部所有图元的lsp？送一个删除外部图元的lsp http://bbs.mjtd.com/thread-85904-2-1.html
回复 支持 反对

使用道具 举报

357785513
发表于 2012-12-21 12:59:49 | 显示全部楼层
如果内部的可以多选就好
回复 支持 反对

使用道具 举报

004
 楼主| 发表于 2012-12-21 13:20:46 来自手机 | 显示全部楼层
谢谢，正是我想要的，看来搜索还得用多个相近关键字，写之前先问问的好。
回复 支持 反对

使用道具 举报

ddbb2008
发表于 2013-3-28 16:30:11 | 显示全部楼层
如果可以局部复制就好了，，，
回复 支持 反对

使用道具 举报

mycad
发表于 2013-3-30 13:20:58 | 显示全部楼层
好像还是有点问题，
*无效*
程序出错！返回到起始状态。
回复 支持 反对

使用道具 举报

004
 楼主| 发表于 2013-3-30 15:53:21 | 显示全部楼层
mycad 发表于 2013-3-30 13:20
好像还是有点问题，
*无效*
程序出错！返回到起始状态。

目前为止最好的裁切源码
http://bbs.mjtd.com/thread-85904-2-1.html
回复 支持 反对

使用道具 举报

msyangyi
发表于 2013-9-26 14:01:00 | 显示全部楼层
都是高手，学习了
回复 支持 反对

使用道具 举报

wxd20130610
发表于 2014-1-18 17:13:11 | 显示全部楼层
好像对于宽度不为0的多段线不管用。
回复 支持 反对

使用道具 举报

cyfdean
发表于 2015-1-10 11:38:09 | 显示全部楼层
都是高手，学习了
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-5-23 09:09 , Processed in 0.164045 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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