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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › [求助]一张大的底图，如何快速裁切出其中一块矩形区域另 ...
1234下一页
返回列表 发新帖
楼主: nabworm

[求助]一张大的底图，如何快速裁切出其中一块矩形区域另存？

  [复制链接]
gdzhou
发表于 2007-9-11 16:18 | 显示全部楼层

试试我的呢～～

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

jdhszh
发表于 2007-9-14 10:08 | 显示全部楼层

隐含模块中的编译错误!

工程不可查看!

耍人呢?

回复 支持 反对

使用道具 举报

jdhszh
发表于 2007-9-14 10:37 | 显示全部楼层
这个还行,不会把块丢失
[QUOTE]
  3. (DEFUN C:TirmViaLWP(/ old_cmd Ename loop)
  4.   (SETQ old_cmd (GETVAR "CMDECHO"))
  5.   (SETVAR "CMDECHO" 0)
  6.   ;(SETQ Ename (CAR (ENTSEL "\n选择裁图范围:")))
  7.   (SETQ loop 1)
  8.   (WHILE loop
  9.     (SETQ ObjPos (ENTSEL "\n选择裁图范围 :"))
  10.     (COND
  11.       ((NULL ObjPos) (PROMPT "已选择0个, 找到0个"))
  12.       ((not (member (cdr (assoc 0 (setq ed (entget (setq en (car ObjPos)))))) '("POLYLINE" "LWPOLYLINE")) )
  13.        (prompt ": 目标不是多义线!"))
  14.       (t (setq loop nil))
  15.     )
  16.   )
  17.   (SETQ Ename (CAR ObjPos))
  18.   (TrimByFence0 (GetListOfPline0 Ename))
  19.   (SETVAR "CMDECHO" old_cmd)
  20.   (PRINC)
  21. )
  23. ;;;******************************************
  24. ;;;**************剪裁并删除图外线状物体的子函数****
  25. ;;;******************************************
  26. (DEFUN TrimByFence0(knownCoordList / Count OFFSETDIST BoundaryLine newExtent newCoordList COORD objSequence)
  27. (SETVAR "PLINETYPE" 2)
  28. (SETQ Count 0)
  29. (COMMAND "ZOOM" "E")
  30.    ;;;;;;;;裁减21次
  31. (REPEAT 21
  32.     (SETQ OFFSETDIST (- 2 (* 0.095 Count)))
  33.     (SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
  34.     (COMMAND "OFFSET" OFFSETDIST BoundaryLine "-1000,-1000" "")
  35.     (SETQ newExtent (ENTLAST))
  36.     (SETQ newCoordList (GetListOfPline0 newExtent) )
  37.     (SETQ objSequence 0)
  38.     (SETQ COORD (NTH objSequence newCoordList))
  39.     (COMMAND "TRIM" BoundaryLine "" "F")
  40.     (WHILE COORD
  41.              (COMMAND COORD)
  42.              (SETQ objSequence (+ objSequence 1))
  43.              (SETQ COORD (NTH objSequence newCoordList))
  44.     )
  45.     (SETQ COORD (NTH 0 newCoordList))
  46.     (COMMAND COORD "" "" "ERASE" BoundaryLine newExtent "")
  47.     (SETQ Count (+ Count 1))
  48. )
  50. ;;;;再以外扩0.1的多边形为基础进行裁切(每次offset 0.01,共10次)
  51. (SETQ Count 0)
  52. (REPEAT 10
  53.     (SETQ OFFSETDIST (- 0.1 (* 0.01 Count)))
  54.     (SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
  55.     (COMMAND "OFFSET" OFFSETDIST BoundaryLine "-1000,-1000" "")
  56.     (SETQ newExtent (ENTLAST))
  57.     (SETQ newCoordList (GetListOfPline0 newExtent) )
  58.     (SETQ objSequence 0)
  59.     (SETQ COORD (NTH objSequence newCoordList))
  60.     (COMMAND "TRIM" BoundaryLine "" "F")
  61.     (WHILE COORD
  62.              (COMMAND COORD)
  63.              (SETQ objSequence (+ objSequence 1))
  64.              (SETQ COORD (NTH objSequence newCoordList))
  65.     )
  66.     (SETQ COORD (NTH 0 newCoordList))
  67.     (COMMAND COORD "" "" )
  68.     (COMMAND "ERASE" BoundaryLine newExtent "")
  69.     (SETQ Count (+ Count 1))
  70. )
  72.    ;;;;;;得到最大最小坐标,得到内扩0.1的线坐标表
  73.     (setq CenterSeg (GetCoordnateOfBLTR0 knownCoordList))
  74.     (setq point-BL (car CenterSeg)
  75.           point-TR (cadr CenterSeg))
  76.     (setq Xmax (car point-TR)
  77.           Ymax (cadr point-TR)
  78.           Xmin (car point-BL)
  79.           Ymin (cadr point-BL))
  80.   
  81.     ;;;得到范围的中心点
  82.     (setq point-Center (list (/ (+ (car point-BL) (car point-TR)) 2) (/ (+ (cadr point-BL) (cadr point-TR)) 2)))
  83.    
  84.     (SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
  85.     (COMMAND "OFFSET" "0.01" BoundaryLine point-Center "")
  86.     (SETQ newExtent (ENTLAST))
  87.     (setq In-CoordList (GetListOfPline0 (ENTLAST)))
  88.     (COMMAND "ERASE" BoundaryLine newExtent "")
  89. ***********************************************************************************
  90.    ;;;;;删除剩下的与边界搭上且在边界外的实体;;;;;;;;;;;;;;;;;
  91.     ;;;;;;思路:先取出找出宽度大于0的线,记录有Num-Wider条,一条一条的将宽度变为0
  92.     ;;;;;;再取出与扩展后的边界相交的线(用"F"过滤),
  93.     ;;;;;;用undo命令Num-Wider次,将宽度改回原来的宽度,删除与扩展后的边界相交的线
  94.     (setq p1 (nth 0 newcoordlist))
  95.     (setq newcoordlist (append newcoordlist (list p1)))
  96.     ;;;;ss-Wider为宽度大于0的线
  97.     (setq ss-Wider (ssget "F" newCoordList
  98.         '((-4 . "<or")
  99.             (-4 . "<and")
  100.                 (-4 . "<or")
  101.                     (0 . "LINE")(0 . "POLYLINE")(0 . "LWPOLYLINE")
  102.                 (-4 . "or>")
  103.                 (-4 . "<or")
  104.                     (-4 . ">")(40 . 0.0)(-4 . ">")(41 . 0.0)   
  105.                 (-4 . "or>")        
  106.             (-4 . "and>")
  107.         (-4 . "or>"))
  108.     ))
  109.     (setq Num-Wider 0)    ;;;;;;Num-Wider为宽度大于0的线段
  110.     (if ss-Wider
  111.        (progn
  112.         (setq i 0)
  113.         (setq Num-Wider (sslength ss-Wider))
  114.         (repeat Num-Wider
  115.            (setq ss-every (ssname ss-Wider i))
  116.            (setq sse-every (entget ss-every))
  117.            (command "pedit" ss-every "w" "0" "")
  118.            (setq i (+ i 1))
  119.         )
  120.        )
  121.     )
  122.     ;;;;;;ss-must-delete为必须删除的线段
  123.    
  124.     (setq ss-must-delete (ssget "F" newCoordList
  125.         '((-4 . "<or")
  126.             (0 . "LINE")(0 . "LWPOLYLINE")(0 . "POLYLINE")(0 . "ARC")(0 . "CIRCLE")
  127.         (-4 . "or>"))
  128.     ))
  129.     ;;;;;;ss-must-keep为必须保留的线段
  130.     (setq ss-must-keep nil)
  131.     (SETQ ss-must-keep (SSGET "CP" In-CoordList))
  132.     (if (= ss-must-keep nil)
  133.         (setq ss-must-keep (ssadd))
  134.     )
  135.     (if (> Num-Wider 0)
  136.         (command "undo" Num-Wider)
  137.     )
  138.     (if ss-must-delete
  139.         (command "erase" ss-must-delete "r" ss-must-keep "")
  140.     )
  141. ;;;;;;;;删除搭界的线段完毕   
  143. ;;;;;删除图外实体
  144.     (SETQ SS1 (SSGET "CP" knownCoordList))    ;;;;;;;ss1为所有范围内实体
  145.     (IF (= SS1 nil)
  146.         (COMMAND "ERASE" "all" "")
  147.         (COMMAND "ERASE" "all" "R" SS1 "")
  148.     )      
  149.      ;;;;;删除完毕
  150. ***********************************************************************************
  151. )
  152. ;;;***********************************************************
  153. ;;;;;;;根据折线实体名得到各节点的坐标组成的表的子函数
  154. ;;;***********************************************************
  155. (DEFUN GetListOfPline0(EntityName / SSE_Pline Coordnate_Vertex LastList)
  156. (SETQ SSE_Pline (ENTGET EntityName))
  157. (SETQ LastList nil)
  158. (IF (= (CDR (ASSOC 0 SSE_Pline)) "LINE")
  159. (PROGN
  160.     (setq p1 (cdr (assoc 10 sse_pline))
  161.           p2 (cdr (assoc 11 sse_pline)))
  162.     (setq p1 (reverse (cdr (reverse p1)))
  163.           p2 (reverse (cdr (reverse p2))))
  164.     (SETQ LastList (list p1 p2))
  165. )
  166. )
  167. (IF (= (CDR (ASSOC 0 SSE_Pline)) "LWPOLYLINE")
  168. (PROGN
  169.     (SETQ LastList (LIST (LIST 0 0)))
  170.     (SETQ N 0)
  171.     (WHILE (/= (NTH N SSE_PLINE) NIL)
  172.             (IF (= (CAR (NTH N SSE_PLINE)) 10)
  173.             (SETQ LastList (APPEND LastList (LIST (LIST (CADR (NTH N SSE_PLINE)) (CADDR (NTH N SSE_PLINE)))) ))
  174.         )
  175.         (SETQ N (+ N 1))
  176.     )
  177.     (SETQ LastList (CDR LastList))
  178. )
  179. )
  181. (IF (= (CDR (ASSOC 0 SSE_Pline)) "POLYLINE")
  182. (PROGN
  183.     (SETQ LastList (LIST (LIST 0 0)))
  184.     (SETQ newEntityName (ENTNEXT EntityName))
  185.     (WHILE (= (CDR (ASSOC 0 (ENTGET newEntityName))) "VERTEX")
  186.         (SETQ LastList (APPEND LastList (LIST (LIST (CADR (ASSOC 10 (ENTGET newEntityName))) (CADDR (ASSOC 10 (ENTGET newEntityName))) )) ))
  187.         (SETQ newEntityName (ENTNEXT newEntityName))
  188.     )
  189.     (SETQ LastList (CDR LastList))
  190. )
  191. )
  192. (IF (= (CDR (ASSOC 0 SSE_Pline)) "ARC")
  193. (PROGN
  194.     (SETQ LastList (LIST (LIST 0 0)))
  195.     (COMMAND "PEDIT" EntityName "Y" "" "CONVERT" "P" "S" (ENTLAST) "")
  196.     (SETQ SSE_Pline (ENTGET (ENTLAST)))
  197.     (SETQ N 0)
  198.     (WHILE (/= (NTH N SSE_PLINE) NIL)
  199.             (IF (= (CAR (NTH N SSE_PLINE)) 10)
  200.             (SETQ LastList (APPEND LastList (LIST (LIST (CADR (NTH N SSE_PLINE)) (CADDR (NTH N SSE_PLINE)))) ))
  201.         )
  202.         (SETQ N (+ N 1))
  203.     )
  204.     (SETQ LastList (CDR LastList))
  205.     (COMMAND "UNDO" 2)
  206. ))
  207. (IF (= (CDR (ASSOC 0 SSE_Pline)) "CIRCLE")
  208. (PROGN
  209.     (SETQ Ra1 (CDR (assoc 40 SSE_Pline)))
  210.     (SETQ P-Center (CDR (assoc 10 SSE_Pline)))
  211.     (SETQ P1 (POLAR P-Center 0 Ra1))
  212.     (SETQ P2 (POLAR P-Center (* PI 0.5) Ra1))
  213.     (SETQ P3 (POLAR P-Center (* PI 1.0) Ra1))
  214.     (SETQ P4 (POLAR P-Center (* PI 1.5) Ra1))
  215.     (SETQ LastList (LIST P1 P2 P3 P4))
  216. ))
  217. (SETQ LastList LastList)
  218. )
  219. ;;;***********************************************************
  220. ;;;;;;;;;;;;根据一个坐标表得到一条线的子函数
  221. ;;;***********************************************************
  222. (DEFUN GetLwPlineFromList0(knownCoordList / newCoordList MainPline)
  223. (SETVAR "PLINETYPE" 2)
  224. (COMMAND "._PLINE")
  225. (FOREACH newCoordList knownCoordList (COMMAND newCoordList))
  226. (COMMAND "C")
  227. (SETQ MainPline (ENTLAST))
  228. )
  230. ;;;***********************************************************
  231. ;;;;;;;从坐标表中得到范围的左下角和右上角坐标的子函数
  232. ;;;***********************************************************
  233. (DEFUN GetCoordnateOfBLTR0(knownCoordList / CurrenPoint Xmin Ymin Xmax Ymax nowCoordnateList)
  234. (SETQ nowCoordnateList knownCoordList)
  235. (SETQ CurrenPoint (CAR nowCoordnateList)
  236.       Xmin (CAR CurrenPoint)
  237.       Ymin (CADR CurrenPoint)
  238.       Xmax (CAR CurrenPoint)
  239.       Ymax (CADR CurrenPoint))
  240. (SETQ nowCoordnateList (CDR nowCoordnateList))
  241. (WHILE (/= nowCoordnateList nil)
  242.       (SETQ CurrenPoint (CAR nowCoordnateList))
  243.       (IF (< (CAR CurrenPoint) Xmin) (SETQ Xmin (CAR CurrenPoint)))
  244.       (IF (< (CADR CurrenPoint) Ymin) (SETQ Ymin (CADR CurrenPoint)))
  245.       (IF (> (CAR CurrenPoint) Xmax) (SETQ Xmax (CAR CurrenPoint)))
  246.       (IF (> (CADR CurrenPoint) Ymax) (SETQ Ymax (CADR CurrenPoint)))
  247.       (SETQ nowCoordnateList (CDR nowCoordnateList))
  248. )
  249. (SETQ nowCoordnateList (LIST (LIST Xmin Ymin)(LIST Xmax Ymax)))
  250. )
  251. [/QUOTE]

评分

参与人数 1金钱 +15 贡献 +5 激情 +5 收起 理由
yfy2003 + 15 + 5 + 5 【好评】好程序

查看全部评分

回复 支持 反对

使用道具 举报

gdzhou
发表于 2007-9-19 12:03 | 显示全部楼层
jdhszh发表于2007-9-14 10:08:00隐含模块中的编译错误!工程不可查看!耍人呢?

没有啊，我用起都是正常得很呢

回复 支持 反对

使用道具 举报

dxhy
发表于 2007-11-14 07:31 | 显示全部楼层

回复：（gdzhou）以下是引用jdhszh在2007-9-14 10:08:...

好象是丢失了什么DLL文件！
回复 支持 反对

使用道具 举报

chtd
发表于 2007-12-7 22:33 | 显示全部楼层
scas裁图也很好使。
回复 支持 反对

使用道具 举报

kuangbingo
发表于 2007-12-9 02:17 | 显示全部楼层
本帖最后由 作者 于 2007-12-9 2:17:53 编辑

唉，在Microstation里 一个 FF=命令就搞定了。还用费那么多功夫。
回复 支持 反对

使用道具 举报

chji
发表于 2007-12-27 08:42 | 显示全部楼层
xgr发表于2007-8-30 0:08:00试试我的代码(defun c:txjq3 (/      aa     oldgroup     oldcmd oldblip  oldsnap  en   

这个能不能做成可加载的程序呀,我是菜鸟呀,不会呢,但经常会用这样的需要,谢谢

回复 支持 反对

使用道具 举报

kuangbingo
发表于 2008-1-13 01:32 | 显示全部楼层
本帖最后由 作者 于 2008-1-13 1:33:56 编辑

不知道，你们的程序能否实现我的效果.在MicroStation里真的很容易裁剪图形。

http://upload.py99.net/files/38/flash/cutdemo.swf
回复 支持 反对

使用道具 举报

tdz78922
发表于 2008-1-22 09:08 | 显示全部楼层
用CASS有个命令
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-6-15 14:36 , Processed in 0.374721 second(s), 21 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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