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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 【求双线切割工具】Gu_xl版主已完美解决！~~
12345678910... 33下一页
返回列表 发新帖
查看: 35655|回复: 326

【求双线切割工具】Gu_xl版主已完美解决！~~

  [复制链接]
daidong013
发表于 2011-7-3 13:46:33 | 显示全部楼层 |阅读模式
本帖最后由 daidong013 于 2011-7-5 16:09 编辑

求非常实用的双线切割工具!~~

本帖子中包含更多资源

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

x

评分

参与人数 1金钱 -10 收起 理由
caoyin -10 请勿只发图片

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下

本帖被以下淘专辑推荐:

回复

使用道具 举报

daidong013
 楼主| 发表于 2011-7-3 15:34:50 | 显示全部楼层
本帖最后由 daidong013 于 2011-7-3 18:35 编辑

沙发！还望需要此功能的朋友用力顶啊！~~~
回复 支持 0 反对 1

使用道具 举报

ninja37
发表于 2022-10-26 21:25:14 | 显示全部楼层
Gu_xl 发表于 2011-7-5 13:18
回复 dai
dong013 的帖子

版主可不可以修改一下，改成双线可以修剪的样子，被修剪的两个对象是圆矩形或者封闭的多义线。

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

999999
发表于 2020-9-8 22:56:20 | 显示全部楼层
顶起来，多逛逛论坛可以发现好多好东西，，谢谢大神们的辛苦
回复 支持 反对

使用道具 举报

daidong013
 楼主| 发表于 2011-7-3 19:43:10 | 显示全部楼层
本帖最后由 daidong013 于 2011-7-4 10:40 编辑

自己再顶一把！~~~望大侠们出手帮忙！~可参考以下链接
http://bbs.mjtd.com/thread-85203-1-4.html
回复 支持 反对

使用道具 举报

daidong013
 楼主| 发表于 2011-7-4 13:25:02 | 显示全部楼层
快沉底了！~~再加把油！~~
回复 支持 反对

使用道具 举报

daidong013
 楼主| 发表于 2011-7-5 00:31:06 | 显示全部楼层
沙发、板凳、地板全都坐光了！~~
回复 支持 反对

使用道具 举报

Gu_xl
发表于 2011-7-5 11:10:42 | 显示全部楼层
本帖最后由 Gu_xl 于 2011-7-5 19:08 编辑

回复 daidong013 的帖子

  1. ;;;明经通道 编制 By Gu_xl 2011年7月5日
  2. (defun c:DtrimIn(/ p1 p3 p4 dis pl s1  enrec w  enpline pline1 pline1 ss ssbj)
  3.   (setq osmode (getvar 'osmode))
  4.   (setq cmdecho (getvar 'cmdecho))
  5.   (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
  6.   (if *w*
  7.     (progn
  8.   (setq w (getreal (strcat "\n 双线宽度<" (rtos *w* 2 2) ">: ")))
  9.   (if (null w) (setq w *w*) (setq *w* w))
  10.   )
  11.     (progn
  12.       (setq w (getreal (strcat "\n 双线宽度<1.0>: ")))
  13.       (if (null w) (setq w 1.0 *w* w) (setq *w* w))
  14.       )
  15.     )
  16.     (vl-cmdf "_pline")
  17.   (while (= 1 (getvar "cmdactive"))
  18.   (vl-cmdf pause)
  19.     )
  20.   (setq enpline (entlast))
  21.   (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
  22.   (setq pline1 (entlast))
  23.   (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
  24.   (setq pline2 (entlast))
  25.   (setq ssbj (ssadd pline1))
  26.   (ssadd pline2 ssbj)
  27.   (setq pl (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget enpline))))
  28.   (setq p1 (apply 'mapcar (cons 'min pl))
  29.         p3 (apply 'mapcar (cons 'max pl))
  30.         )
  31.   (command "_.Zoom" "_Window" p1 p3 "._Zoom" "0.95x")
  32.   (command "trim" ssbj "" )
  33.   (setq p1 (car pl))
  34.   (foreach a (cdr pl)
  35.     (command "f" p1 a "")
  36.     (setq p1 a)
  37.     )
  38.   (command "")
  39.   (entdel enpline)
  40.   (initget 7 "Yes No  ")
  41.   (setq kd (getkword "\n 是否删除双线[Yes/No]<No>:"))
  42.   (if (= "Yes" kd)
  43.     (progn
  44.       (entdel pline1)
  45.       (entdel pline2)
  46.       )
  47.     )
  48.   (mapcar 'setvar (list 'osmode 'cmdecho) (list osmode cmdecho))
  49.   (princ)
  50.   )

评分

参与人数 1明经币 +1 收起 理由
wayne_myles + 1 很给力!

查看全部评分

回复 支持 反对

使用道具 举报

daidong013
 楼主| 发表于 2011-7-5 11:48:08 | 显示全部楼层
本帖最后由 daidong013 于 2011-7-5 11:53 编辑

回复 Gu_xl 的帖子

版主真厉害啊！~~就是这样的效果！~~~
能加上捕捉吗？！~~~感谢感谢！~~
还有切割矩形，圆的时候切割的有点不干净！~~
回复 支持 反对

使用道具 举报

Gu_xl
发表于 2011-7-5 13:18:52 | 显示全部楼层
本帖最后由 Gu_xl 于 2012-3-31 14:40 编辑

回复 dai
dong013 的帖子

改进版：
  1. ;;;明经通道 编制 By Gu_xl 2011年7月5日
  2. (defun c:DtrimIn(/ p1 p3 p4 dis pl s1  en w  enpline pline1 pline1 ss ssbj kd ss1 ss2 ss3 ss4 pl1 pl2 removesel)
  3. (setq os (getvar 'osmode))
  4. (setq cmd (getvar 'cmdecho))
  5. (mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
  6.   (if *w*
  7.     (progn
  8.   (setq w (getdist (getvar "viewctr") (strcat "\n 双线宽度<" (rtos *w* 2 2) ">: ")))
  9.   (if (null w) (setq w *w*) (setq *w* w))
  10.   )
  11.     (progn
  12.       (setq w (getreal (strcat "\n 双线宽度<1.0>: ")))
  13.       (if (null w) (setq w 1.0 *w* w) (setq *w* w))
  14.       )
  15.     )
  16.   (initget 7 "Yes No  ")
  17.   (setq kd (getkword "\n 是否删除双线[Yes/No]<No>:"))
  18.   (setq en (entlast))
  19.   (princ "\n 请绘制双线中线: ")
  20.   (setvar 'osmode 3071)
  21.   (vl-cmdf "_pline")
  22.   (while (= 1 (getvar "cmdactive"))
  23.   (vl-cmdf pause)
  24.     )
  25.   (setvar 'osmode 0)
  26.   (setq enpline (entlast))
  27.   (if (not (equal en enpline))
  28.     (progn
  29.   (vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
  30.   (setq pline1 (entlast))
  31.   (vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
  32.   (setq pline2 (entlast))
  33.   (setq ssbj (ssadd pline1))
  34.   (ssadd pline2 ssbj)
  35.   (setq pl (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline1))))
  36.   (setq pl (append pl (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline2))))))
  37.   (setq p1 (apply 'mapcar (cons 'min pl))
  38.         p3 (apply 'mapcar (cons 'max pl))
  39.         )
  40.   (command "_.Zoom" "_Window" p1 p3 "._Zoom" "0.95x")
  41.   (setq dis (* 0.15 w))
  42.     (vla-Offset (vlax-ename->vla-object enpline) (- (/ w 2.0) dis))
  43.   (setq pline3 (entlast))
  44.   (vla-Offset (vlax-ename->vla-object enpline) (+ dis (/ w -2.0)))
  45.   (setq pline4 (entlast))
  46.   (setq pl1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline3))))
  47.   (setq pl2 (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline4)))))
  48.   (entdel pline3)
  49.   (entdel pline4)
  50.   (vla-put-Visible (vlax-ename->vla-object pline1) :vlax-false)
  51.   (vla-put-Visible (vlax-ename->vla-object pline2) :vlax-false)
  52.   (setq ss1 (ssget "f" (list (car pl1) (last pl2))) ss2 (ssget "f" (list (last pl1) (car pl2))))
  53.   (if ss1
  54.     (repeat (setq n (sslength ss1))
  55.       (setq removesel (cons (ssname ss1 (setq n (1- n))) removesel))
  56.       )
  57.     )
  58.   (if ss2
  59.     (repeat (setq n (sslength ss2))
  60.       (setq removesel (cons (ssname ss2 (setq n (1- n))) removesel))
  61.       )
  62.     )
  63.   (mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-false)) removesel)
  64.   (vla-put-Visible (vlax-ename->vla-object pline1) :vlax-true)
  65.   (vla-put-Visible (vlax-ename->vla-object pline2) :vlax-true)
  66.   (setq pl1 (append pl1 pl2))
  67.   (command "trim" ssbj "" )
  68.   (setq p1 (car pl1))
  69.   (foreach a (cdr pl1)
  70.     (command "f" p1 a "")
  71.     (setq p1 a)
  72.     )
  73.   (command "")
  74.   (mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-true)) removesel)
  75.   (entdel enpline)
  76.   (setq ss (ssget "wp" pl))
  77.   (if ss (command "erase" ss ""))
  78.   (if (= "Yes" kd)
  79.     (progn
  80.       (entdel pline1)
  81.       (entdel pline2)
  82.       )
  83.     )
  84.   )
  85.     )
  86. (mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
  87.   (princ)
  88.   )


评分

参与人数 1明经币 +1 收起 理由
flytoday + 1 很给力!希望G版绘制中线选择增加个选择中线.

查看全部评分

回复 支持 反对

使用道具 举报

daidong013
 楼主| 发表于 2011-7-5 13:45:30 | 显示全部楼层
回复 Gu_xl 的帖子

近乎完美啊！~~真的是太厉害了！~~崇拜啊！~~
不过在使用完这个工具后，在使用过程中有捕捉，用完后捕捉就没有了！~~
回复 支持 反对

使用道具 举报

Gu_xl
发表于 2011-7-5 15:55:43 | 显示全部楼层
楼上已改！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-6 07:08 , Processed in 0.184272 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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