删除块并连接t

ademontis · 发表于 2022-7-6 09:27:24

好的，伙计们，这是一个需要帮助的冷冻器。。。
让我们假设你必须删除图形中某些线的块，并连接被块打断的两条线。。。

我有点Lisp程序，但似乎不管用。。。。我不知道为什么。。。
它应该加载在AutoCAD2008上。

有什么想法吗？
提前感谢

（定义C:DELSYM（/setv01 setv02 setv03 tbver1 tbver2）
（setvar“CMDECHO”0）
（setq setv01（getvar“BLIPMODE”）
setv02（getvar“平地”）
setv03（getvar“CLAYER”））
（setvar“BLIPMODE”0）
（setvar“FLATLAND”0）
（SSBLC）
（DELBLC lstnbl）
（setq lstnbl nil）
（setvar“BLIPMODE”setv01）
（setvar“FLATLAND”setv02）
（prin1）
)
（定义SSBLC（/sstot指示nbl1 ifblc）
（提示“\n选择要删除的符号：”）
（setq sstot（ssget））
（setq表示0）
（重复（sslength sstot）
（setq nbl1（ssname sstot indice）
ifblc（assoc 0（entget nbl1））
ifblc（cdr ifblc））
（如果（等于“插入”ifblc）
（setq lstnbl（cons nbl1 lstnbl））
)
（setq indice（1+indice））
)
（如果（不等于（lstnbl类型）列表））
（程序
（提示“nSYMBOL不是块”）
（SSBLC）
)
)
)
（defun DELBLC（lstnbl/tblblo ptins ptmin ptmax lstdx scf angbl nbl noblo）
（while（不等于（长度lstnbl）0））
（setq noblo（汽车lstnbl）
tblblo（entget noblo）
lstnbl（cdr lstnbl）
PTIN（cdr（assoc 10 tblblo））
scf（cdr（assoc 41 tblblo））
scf（abs scf）
angbl（cdr（assoc 50 tblblo））
nbl（cdr（assoc 2 tblblo）））
（DETVT1 nbl）
（if（or（null lstdx）（等于（length lstdx）1））
（提示“\n可能加入PLINE”）
（程序
（PTEXT lstdx scf ptins angbl）
（恩德尔·诺布罗）
（PL1_2 ptmax ptmin setv03）
)
)
)
)
（defun PTEXT（lstdx scf ptins angbl/ltrm1 ltrm2 nnlist）
（如果（不等于（长度lstdx）2））
（程序
（setq ltrm1（车辆lstdx）
ltrm2（车辆lstdx）
lstdx（cdr lstdx）
nnlist（长度lstdx））
（while（not（等于nnlist 0））
（setq ltrm1（最大ltrm1（车辆lstdx））
ltrm2（最小ltrm2（车辆lstdx））
lstdx（cdr lstdx）
nnlist（长度lstdx））
)
（setq ltrm1（*ltrm1 scf）
ltrm2（*ltrm2 scf））
)
（setq ltrm1（车辆lstdx）
ltrm1（*ltrm1 scf）
ltrm2（cadr lstdx）
ltrm2（*ltrm2 scf）
lstdx（无）
)
（setq ptmin（极性ptins angbl ltrm1）
ptmax（极性PTIN angbl ltrm2）
ptmin（osnap ptmin“结束”）
ptmax（osnap ptmax“end”））
)
（defun PL1_2（ptmax ptmin setv03/lstver entl1 entl2 vpl1 ptn nlin1 nlin2 lstv1
lstv2 lstvA lstvB play player lastpl envert）
（setq nlin1（ssname（ssget ptmax）0）
播放（cdr（assoc 8（entget nlin1）））
（如果（不是（等于setv03间隙））
（setq播放器（assoc 8（entget nlin1）））
)
（setq entl1（entnext nlin1））
（VERPL1 entl1）
（setq lstv1（反向lstver）
nlin2（ssname（ssget ptmin）0）
entl2（entnext nlin2）
lstver无）
（VERPL1 entl2）
（setq lstv2（反向lstver）
vpl1（车辆lstv1））
（如果（或）（和（等于（car vpl1）（car ptmax）0.0005）
（等于（cadr vpl1）（cadr ptmax）0.0005）
（和（等于（car vpl1）（car ptmin）0.0005）
（等于（cadr vpl1）（cadr ptmin）0.005）））
（setq lstvA（cdr lstv1）
lstvB（cdr（反向lstv2）））
（setq lstvA（cdr lstv2）
lstvB（cdr（反向lstv1）））
)
（重复（长度lstvB）
（setq lstvA（cons（car lstvB）lstvA）
lstvB（cdr lstvB））
)
（entdel nlin1）
（entdel nlin2）
（命令“PLINE”（car lstvA））
（重复（长度lstvA）
（setq lstvA（cdr lstvA）
ptn（汽车lstvA））
（命令ptn）
)
（命令）
（如果（不是（空玩家））
（程序
（setq lastpl（entget（entlast））
lastpl（替补球员（assoc 8 lastpl）lastpl）
（entmod lastpl）
)
)
)
（defun VERPL1（envert/tbvert ptvert）；构建选定多段线的顶点列表
（setq tbvert（entget envert））
（while（等于（cdr（assoc 0 tbvert））“顶点”）
（setq ptvert（assoc 10 tbvert）
ptvert（cdr ptvert）
lstver（cons ptvert lstver）
envert（entnext envert）
tbvert（entget envert））
)
)
（defun DETVT1（nbl/tblbl ENT tbent）；距离（dx-dy-dz）和相关修剪点的提取
（setq tblbl（tblsearch“block”nbl）
NET（cdr（assoc-2 tblbl）））
（while（not（null nent））
（setq tbent（entget NET））
（如果（等于（cdr（assoc 0 tbent））“点”）
（如果（和（不等于（car（cdr（assoc 10 tbent）））0.0））
（和（等于（cadr（cdr（assoc 10 tbent）））0.0）
（等于（caddr（cdr（assoc 10 tbent）））0.0）
)
)
（setq lstdx（cons（car（cdr（assoc 10 tbent）））lstdx））
)
)
（setq nent（entnext nent））
)
)

Lee Mac · 发表于 2022-7-6 09:43:26

删除块并使用AutoCAD“Join”命令可能更容易。

BlackBox · 发表于 2022-7-6 09:46:02

请使用

copy

 tags[/b].<p> </p><p>Select the block, select the first line, select the second line, delete the block, and fillet the lines (you may need to check the angle of the nearest line segments for separate action).</p>