分享一个沿着线切割图纸的LSP

njygx

有时候删除图纸一部分很麻烦，使用这个相对简单，不过填充无法删除，但也很爽快了。

下面是程序，有几个命令，奈何我只是个搬运工，使用“EXTRIM”命令，选择自己画好的切割线，然后鼠标右键选择删除的方向。




(defun c:exb2c ( / colect_entdata store_entdata colect_modified_entdata sel_mod_ents
                  hig osm c1 c2 p ss entdata )

(defun colect_entdata ( / ss i ent entdata )
   (setq ss (ssget "_X"))
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq entdata (cons (entget ent) entdata))
   )
   entdata
)

(defun store_entdata nil
   (setq entdata (colect_entdata))
   (princ)
)

;;; Modify entities ;;;

(defun colect_modified_entdata ( / ss i ent entdatachk entdatamod )
   (setq ss (ssget "_X"))
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq entdatachk (cons (entget ent) entdatachk))
   )
   (foreach data entdatachk
     (if (not (vl-some '(lambda ( x ) (equal x data 1e-6)) entdata))
       (setq entdatamod (cons data entdatamod))
     )
   )
   entdatamod
)

(defun sel_mod_ents nil
   (setq ss (ssadd))
   (foreach data (colect_modified_entdata)
     (ssadd (cdr (assoc -1 data)) ss)
   )
   (princ)
)

;;; Main function ;;;

(vl-load-com)

(setq hig (getvar 'highlight))
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(if (not (or etrim (not (vl-catch-all-error-p (vl-catch-all-apply 'load (list (findfile "extrim.lsp")))))))
   (progn
     (alert "\nExpress Tool EXTRIM not available - quitting...")
     (exit)
   )
)
(setq c1 (car (entsel "\nPick first curve")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c1)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c1 (car (entsel "\nPick first curve")))
)
(setq c2 (car (entsel "\nPick second curve")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c2)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c2 (car (entsel "\nPick second curve")))
)
(initget 1)
(setq p (getpoint "\nPick or specify point between 2 prviously picked curves where do you want extrim to be processed : "))
(store_entdata)
(etrim c1 p)
(sel_mod_ents)
(command "_.copybase" '(0.0 0.0 0.0) ss "")
(command "_.undo" "3")
(etrim c2 p)
(command "_.pasteclip" '(0.0 0.0 0.0))
(setvar 'osmode osm)
(setvar 'highlight hig)
(princ)
)

香远益清

汉化一下不更好吗？
(defun c:exb2c( / colect_entdata store_entdata colect_modified_entdata sel_mod_ents
                  hig osm c1 c2 p ss entdata )

(defun colect_entdata ( / ss i ent entdata )
   (setq ss (ssget "_X"))
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq entdata (cons (entget ent) entdata))
   )
   entdata
)

(defun store_entdata nil
   (setq entdata (colect_entdata))
   (princ)
)

;;; Modify entities ;;;

(defun colect_modified_entdata ( / ss i ent entdatachk entdatamod )
   (setq ss (ssget "_X"))
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq entdatachk (cons (entget ent) entdatachk))
   )
   (foreach data entdatachk
     (if (not (vl-some '(lambda ( x ) (equal x data 1e-6)) entdata))
       (setq entdatamod (cons data entdatamod))
     )
   )
   entdatamod
)

(defun sel_mod_ents nil
   (setq ss (ssadd))
   (foreach data (colect_modified_entdata)
     (ssadd (cdr (assoc -1 data)) ss)
   )
   (princ)
)

;;; Main function ;;;

(vl-load-com)

(setq hig (getvar 'highlight))
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(if (not (or etrim (not (vl-catch-all-error-p (vl-catch-all-apply 'load (list (findfile "extrim.lsp")))))))
   (progn
     (alert "\n快速修剪工具不可用，退出...")
     (exit)
   )
)
(setq c1 (car (entsel "\n选择第一条线")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c1)))
   (prompt "\n选取的曲线属性不正确，重选...")
   (setq c1 (car (entsel "\n选择第一条线")))
)
(setq c2 (car (entsel "\n选择第二条线")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c2)))
   (prompt "\n选取的曲线属性不正确，重选...")
   (setq c2 (car (entsel "\n选择第二条线")))
)
(initget 1)
(setq p (getpoint "\n在两条先前拾取的曲线之间拾取或指定要处理外部的点 : "))
(store_entdata)
(etrim c1 p)
(sel_mod_ents)
(command "_.copybase" '(0.0 0.0 0.0) ss "")
(command "_.undo" "3")
(etrim c2 p)
(command "_.pasteclip" '(0.0 0.0 0.0))
(setvar 'osmode osm)
(setvar 'highlight hig)
(princ)
)

njygx

ynhh 发表于 2023-9-13 17:00
谢谢分享
行业不同
要有个示范动画就好理解了

好的，有时间做个动画

njygx

kexiya123 发表于 2023-9-22 17:23
不能用啊，看看能不能不用什么ET

忘了说了，调用命令是EXTRIM

ynhh

谢谢分享
行业不同
要有个示范动画就好理解了
无法试，感觉差一个文件
extrim.lsp

bai2000

etrim,子函数没有吧？

mojianxing

错误了吧，用不了

sowin

可以使用，需要ET扩展工具

mojianxing

多谢分享。可惜我用不了。

panliang9

这个不错哦，安装了et工具就能用了。非常不错，谢谢楼主分享。

jkop

测试之后发现很方便，可以省去匡选的动作，更加有效律的修剪。

669423907

非常感谢楼主分享好源码