[编程申请]：求“超级修剪”lisp程序

onetech · 发表于 2006-12-7 09:23:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

因为在工作中常常用到修剪轴线，一般的修剪是连根修掉，而制图的时候轴线最好出来一段，这样图纸看的方便也美观，所以有那位大虾能提供这样的lisp程序，AUTOCAD14下也能运行，感激不尽。附图

登录/注册后可看大图

phoenixdjq · 发表于 2006-12-7 13:24:47

先发一个给你吧
其实我个人认为还是先偏移一条线,然后以偏移的线为目标进行剪切
也不是很费事.
编了程序也不会让你的绘图速度快多少

onetech · 发表于 2006-12-8 09:40:21

谢谢啊，辛苦了，为什么不能下啊，郁闷，是网站的原因吗？，有谁下到的，发我一个，2275506@163.com

phoenixdjq · 发表于 2006-12-8 11:37:17

(defun c:jj()

(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq jvli (getreal "\n 请输入延长的距离:"))
(setvar "offsetdist" jvli)
(setq mubiao (car (entsel "\n 请选择目标线:")))
(redraw mubiao 3)
(setq a (entsel "\n 请选择被剪切线:" ))

(while a
(setq b (car a))
(setq c (cadr a))
(command "offset" "" mubiao c "")
(setq d (entlast))

(command "trim" d "" c "")
(command "erase" d "")

(setq a (entsel "\n 请选择被剪切线:"))
) ;end while

(setvar "osmode" old)
)

onetech · 发表于 2006-12-8 15:47:21

非常谢谢，能不能加个默认参数象偏移命令OFFSET一样，默认500，可以改数值，这样不用每次运行命令的时候都要输入距离参数，另外加个UNDO参数，剪错了可以UNDO。哈哈，这样使用起来就方便了，最最理想的是，连延伸命令也加进去，延伸到边界再伸出500距离，可能这样不能用一个命令了吧，分两个命令容易一点，大虾，万分感谢。

登录/注册后可看大图

zml84 · 发表于 2006-12-8 16:00:44

下面这是本人昨天写的一个小东西，已通过R14。请楼主过目。
二楼所讲偏移边界的方法，仅适用于要修剪的对象与边界垂直的情况，不能通用。

[FONT=courier new]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;ZML84制作于2006-12-07
;;;==========================================
;;;全局变量说明：
;;;EDGE_JL 外延距离
;;;==========================================
(defun c:tt (/ S0 S1 PT entl LX
PT0 PT0_OLD PT1 PT1_OLD)
(princ "\n★★超级修剪★★")
(setq CMDECHO_OLD (getvar "CMDECHO")
)
(Setvar "CMDECHO" 0)
(if (or (= EDGE_jl "") (= EDGE_jl nil))
(setq EDGE_jl 5.0)
)
(princ
(strcat "\n当前设置:投影="
(nth (getvar "PROJMODE") '("不投影" "当前UCS" "当前视图"))
"，边="
(nth (getvar "EDGEMODE") '("不延伸" "延伸"))
"，外延距离="
(rtos EDGE_JL 2 (getvar "LUPREC"))
)
)
(princ "\n选择剪切边...")
(setq S0 (ssget))
(if (= S0 nil)
(princ "\n★未选择边界，即将退出。")
(progn
(setq S1 nil)
(while (or (/= S1 nil)
(/= nil
(progn (initget 4 "P E D U")
(setq pt (GETPOINT
"\n选择要修剪的对象，或 [投影(P)/边(E)/外延距离(D)/放弃(U)]:"
)
)
)
)
)
(cond
((= pt "P") ;分支一：投影选项设置
(progn
(initget 4)
(SETQ
XX (getint
(strcat
"\n输入投影选项 [无(0)/UCS(1)/视图(2)] <"
(itoa (getvar "PROJMODE"))
">:"
)
)
)
(if (or (= xx 0) (= xx 1) (= xx 2))
(Setvar "PROJMODE" xx)
)
)
)
((= pt "E") ;分支二：边延伸选项设置
(progn
(initget 4)
(SETQ XX (getint
(strcat
"\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
(itoa (getvar "EDGEMODE"))
">:"
)
)
)
(if (or (= xx 0) (= xx 1))
(Setvar "EDGEMODE" xx)
)
)
)
((= pt "D") ;分支三：外延距离选项设置
(progn
(initget 4)
(SETQ XX (getdist
(strcat
"\n输入外延的距离 <"
(rtos EDGE_jl
2
(getvar "LUPREC")
)
">:"
)
)
)
(if (>= xx 0)
(setq EDGE_jl xx)
)
)
)
((= pt "U") ;分支四：撤销上一步操作
(command "_.undo" 1)
)
((listp pt) ;分支五：对选中的对象进行修剪操作
(if (ssget pt)
(progn
(setq s1 (list (ssname (ssget pt) 0) pt))
(setq entl (entget (car s1) '("*"))
LX (dxf_let entl 0)
)
(cond ;对各种对象类型进行操作。
((= LX "LINE")
(progn
(command "_.undo" "be")
(setq pt0_old (dxf_let entl 10)
pt1_old (dxf_let entl 11)
)
(command "_trim" s0 "" s1 "")
(setq entl (entget (car s1) '("*")))
(setq pt0 (dxf_let entl 10)
pt1 (dxf_let entl 11)
)
(if (and (equal pt0 pt0_old)
(equal pt1 pt1_old)
)
(princ "\n★对象未与边相交。")
(progn
(if (not (equal pt0 pt0_old))
;检查起点
(dxf_set
entl
10
(polar pt0
(angle pt0 pt0_old)
EDGE_jl
)
)
(if (not (equal pt1 pt1_old))
;检查终点
(dxf_set
entl
11
(polar pt1
(angle pt1
pt1_old
)
EDGE_jl
)
)
)
)
(command "_.undo" "e")
)
)
)
)
((= LX "ARC")
(princ (strcat "\n★对象类型为""
LX
""，暂不能处理。"
)
)
)
(T
(princ
(strcat "\n★对象类型""
LX
""，拒绝操作。"
)
)
)
)
)
(princ "\n★未选择到对象。")
)
) ;结束分支五
) ;结束 cond 结束分支
(setq S1 nil)
) ;结束 while
)
) ;结束 if
(Setvar "CMDECHO" CMDECHO_OLD)
(princ "\n★正常结束。谢谢使用。")
(princ)
);结束 defun
;;;定义函数，用于提取属性。
(defun dxf_let (ent n)
(if (assoc n ent)
(cdr (assoc n ent))
nil
)
);结束 defun
;;;定义函数，用于修改属性。
(defun dxf_set (ent n nr)
(if (assoc n ent)
(progn
(setq ent (subst (cons n nr) (assoc n ent) ent)
)
(entmod ent)
)
nil
) ;结束 if
);结束 defun
(princ "\n\n★超级修剪。键入命令"TT"执行。")
(princ)
[/FONT]

[FONT=courier new] 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;ZML84制作于2006-12-07 
;;;========================================== 
;;;全局变量说明： 
;;;EDGE_JL  外延距离 
;;;========================================== 
(defun c:tt (/ S0 S1 PT entl LX 
             PT0 PT0_OLD PT1 PT1_OLD) 
    (princ "\n★★超级修剪★★") 
 
    (setq CMDECHO_OLD (getvar "CMDECHO") 
    ) 
    (Setvar "CMDECHO" 0) 
 
    (if        (or (= EDGE_jl "") (= EDGE_jl nil)) 
        (setq EDGE_jl 5.0) 
    ) 
    (princ 
        (strcat        "\n当前设置:投影=" 
                (nth (getvar "PROJMODE") '("不投影" "当前UCS" "当前视图")) 
                "，边=" 
                (nth (getvar "EDGEMODE") '("不延伸" "延伸")) 
                "，外延距离=" 
                (rtos EDGE_JL 2 (getvar "LUPREC")) 
        ) 
    ) 
 
    (princ "\n选择剪切边...") 
    (setq S0 (ssget)) 
 
    (if        (= S0 nil) 
        (princ "\n★未选择边界，即将退出。") 
        (progn 
            (setq S1 nil) 
            (while (or (/= S1 nil) 
                       (/= nil 
                           (progn (initget 4 "P E D U") 
                                  (setq        pt (GETPOINT 
                                               "\n选择要修剪的对象，或 [投影(P)/边(E)/外延距离(D)/放弃(U)]:" 
                                           ) 
                                  ) 
                           ) 
                       ) 
                   ) 
 
                (cond 
                    ((= pt "P") ;分支一：投影选项设置 
                     (progn 
                         (initget 4) 
                         (SETQ 
                             XX        (getint 
                                    (strcat 
                                        "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" 
                                        (itoa (getvar "PROJMODE")) 
                                        ">:" 
                                    ) 
                                ) 
                         ) 
                         (if (or (= xx 0) (= xx 1) (= xx 2)) 
                             (Setvar "PROJMODE" xx) 
                         ) 
                     ) 
                    ) 
 
                    ((= pt "E") ;分支二：边延伸选项设置 
                     (progn 
                         (initget 4) 
                         (SETQ XX (getint 
                                      (strcat 
                                          "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" 
                                          (itoa (getvar "EDGEMODE")) 
                                          ">:" 
                                      ) 
                                  ) 
                         ) 
                         (if (or (= xx 0) (= xx 1)) 
                             (Setvar "EDGEMODE" xx) 
                         ) 
                     ) 
                    ) 
 
                    ((= pt "D") ;分支三：外延距离选项设置 
                     (progn 
                         (initget 4) 
                         (SETQ XX (getdist 
                                      (strcat 
                                          "\n输入外延的距离 <" 
                                          (rtos        EDGE_jl 
                                                2 
                                                (getvar "LUPREC") 
                                          ) 
                                          ">:" 
                                      ) 
                                  ) 
                         ) 
                         (if (>= xx 0) 
                             (setq EDGE_jl xx) 
                         ) 
                     ) 
                    ) 
 
                    ((= pt "U") ;分支四：撤销上一步操作 
                     (command "_.undo" 1) 
                    ) 
 
                    ((listp pt) ;分支五：对选中的对象进行修剪操作 
                     (if (ssget pt) 
                         (progn 
                             (setq s1 (list (ssname (ssget pt) 0) pt)) 
                             (setq entl        (entget (car s1) '("*")) 
                                   LX        (dxf_let entl 0) 
                             ) 
 
                             (cond ;对各种对象类型进行操作。 
                                 ((= LX "LINE") 
                                  (progn 
                                      (command "_.undo" "be") 
                                      (setq pt0_old (dxf_let entl 10) 
                                            pt1_old (dxf_let entl 11) 
                                      ) 
                                      (command "_trim" s0 "" s1 "") 
                                      (setq entl (entget (car s1) '("*"))) 
                                      (setq pt0        (dxf_let entl 10) 
                                            pt1        (dxf_let entl 11) 
                                      ) 
                                      (if (and (equal pt0 pt0_old) 
                                               (equal pt1 pt1_old) 
                                          ) 
                                          (princ "\n★对象未与边相交。") 
                                          (progn 
 
                                              (if (not (equal pt0 pt0_old)) 
     ;检查起点 
                                                  (dxf_set 
                                                      entl 
                                                      10 
                                                      (polar pt0 
                                                             (angle pt0 pt0_old) 
                                                             EDGE_jl 
                                                      ) 
                                                  ) 
                                                  (if (not (equal pt1 pt1_old)) 
     ;检查终点 
                                                      (dxf_set 
                                                          entl 
                                                          11 
                                                          (polar pt1 
                                                                 (angle        pt1 
                                                                        pt1_old 
                                                                 ) 
                                                                 EDGE_jl 
                                                          ) 
                                                      ) 
                                                  ) 
                                              ) 
                                              (command "_.undo" "e") 
                                          ) 
                                      ) 
 
                                  ) 
                                 ) 
                                 ((= LX "ARC") 
                                  (princ (strcat "\n★对象类型为"" 
                                                 LX 
                                                 ""，暂不能处理。" 
                                         ) 
                                  ) 
                                 ) 
                                 (T 
                                  (princ 
                                      (strcat "\n★对象类型"" 
                                              LX 
                                              ""，拒绝操作。" 
                                      ) 
                                  ) 
                                 ) 
                             ) 
                         ) 
                         (princ "\n★未选择到对象。") 
                     ) 
                    ) ;结束 分支五 
 
                ) ;结束 cond 结束分支 
 
                (setq S1 nil) 
            ) ;结束 while 
        ) 
    ) ;结束 if 
 
    (Setvar "CMDECHO" CMDECHO_OLD) 
 
    (princ "\n★正常结束。谢谢使用。") 
    (princ) 
);结束 defun 
 
;;;定义函数，用于提取属性。 
(defun dxf_let (ent n) 
    (if        (assoc n ent) 
        (cdr (assoc n ent)) 
        nil 
    ) 
);结束 defun 
 
;;;定义函数，用于修改属性。 
(defun dxf_set (ent n nr) 
    (if        (assoc n ent) 
        (progn 
            (setq ent (subst (cons n nr) (assoc n ent) ent) 
            ) 
            (entmod ent) 
        ) 
        nil 
    ) ;结束 if 
);结束 defun 
 
(princ "\n\n★超级修剪。键入命令"TT"执行。") 
(princ) 
  [/FONT]

onetech · 发表于 2006-12-8 16:14:37

大侠，厉害，厉害啊。果然好用，只是有一点小小的问题，选择修剪对象的时候，选择框隐去了。另外能不能象TRIM一样加个F参数，可以以直线选取。

chyichin · 发表于 2008-1-7 19:51:57

果然好使，多谢

hmillf · 发表于 2008-1-30 21:07:15

6l楼真是高手呀！而且还热心帮助他人！感动ING。

支持！

swc00 · 发表于 2008-2-2 10:47:46

看看

zhaozwf · 发表于 2008-10-17 09:03:04

有哪位高手，可以上传个，画线修剪那个程序，个人感觉用着挺方便的

dzwmy · 发表于 2008-10-29 21:32:07

高手如云啦，学习了！

animal212 · 发表于 2008-11-5 22:50:10

好久没来晓东了，zml84越来越厉害了啊。

lisell · 发表于 2008-11-21 10:48:01

我现在在找一个能在lisp中生成的实体,用其中的一些实体剪掉一些的,一直没有做到.

flowerson · 发表于 2008-11-22 22:11:22

程序很好！就是框选的时候选框太小且不能一起选。不过能提供源码已经很感谢了！

账号		自动登录	找回密码
密码			立即注册

[编程申请]：求“超级修剪”lisp程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子