jason tay 发表于 2022-7-5 15:59:51

嗨,阿斯米,谢谢你的例行公事。。。它与我拥有的类似,仍然需要逐个单击,这是我面临的问题,因为我的竣工点总是超过600点。我想知道我们是否可以创建一个建议的桩点,然后与竣工点重叠,然后可以得出偏差结果。

jason tay 发表于 2022-7-5 16:03:30

Eldon,一个接一个点击几点是可以的,但如果这是千点,那就是一场噩梦

eldon 发表于 2022-7-5 16:08:58

 
假设你需要10秒来标记一个偏差,那么1000分只需要你两个小时,这远远少于寻求一个自动解决方案的时间
 
可能您的数据设置不允许自动解决方案。例如,当你有一个双桩帽,你如何区分这两个桩?如果你有一个理论位置的数据列表和一个竣工位置的列表,并得到一个计算偏差和绘制竣工图的例程,可能会更容易。要使自动解决方案工作,您必须具有正确的数据设置。
 
但祝你在搜索中好运,但有时加入一些润滑脂会更快。

jason tay 发表于 2022-7-5 16:11:05

有人能告诉我是否要得到点偏差吗
自动需要一个特殊的程序(并指向我的链接),或是很难做到的lisp。谢谢你的帮助

jason tay 发表于 2022-7-5 16:15:18

埃尔登,你说的是我做这项工作的全部想法。
在这个论坛上,我看到很多不可能的事情在所有伟大大师的帮助下变成了可能。。这就是为什么我问

ASMI 发表于 2022-7-5 16:16:01

自动的对于你的画,它的作品很好,对于其他我不知道。
 
1、选择任意桩块
2.选择任何“竣工”点
3.为该“桩”块和空格键选择一个或多个“建议点”以继续。
4.选择所有“桩”块并按空格键。
 
享受
 
(defun c:偏差(/ABPNT ACTDOC BLPATH BSPOS CURFIL CURPT DEVAL FILLST FILLST1 FILLST2 INPT INSBL INSPT OFFLST oldcho OLDOSN PLBLK PPLIST PT1 PT2 ptst PTSET WPT WRKSET ERRCOUNT*ERROR*)(vl load com)(defun*ERROR*(msg)(setvar“CMDECHO”oldcho)(if OLDOSN(setvar“OSMODE”OLDOSN));结束if(if actDoc(vla EndUndoMark actDoc));结束if(princ));结束*错误*(setq oldeecho(getvar“cmdecho”))(setvar“cmdecho”0)(if(and(setq plBlk(entsel“\nPick‘pile’block>”)(=“INSERT”(cdr(assoc 0(setq filLst1(entget(car plBlk);)))));结束和(progn)(如果(和(setq abPnt(entsel“\n点击‘竣工’点>”)(=“点”(cdr(assoc 0(setq filLst2(entget(car abPnt)))))));end和(progn(setq filLst(list’(0。“INSERT”)(assoc 2 filLst1))(while(setq curPt(getpoint“\n指定‘建议的点’或空格键以继续>”))(setq ppList(append(list curPt)ppList));结束while(if ppList(progn(princ“\n>”)(if(setq wrkSet(ssget filLst))(progn(setq wrkSet(vl remove if‘listp(mapcar’cadr(ssnamex wrkSet)))offLst(mapcar’-(lambda(x)(mapcar’-(trans(cdr(assoc 10 filLst1))0 1)x)ppList)oldOsn(getvar“OSMODE”)actDoc(vla get ActiveDocument(vlax get acad object));end setq(vla StartUndoMark actDoc)(setvar“OSMODE”0)(foreach pl wrkSet(setq insPt(trans(cdr(assoc 10(entget pl)))0 1)ptLst(reverse(mapcar)(λ(x)(mapcar’+insPt x))offLst));结束setq(foreach pt ptLst(setq pt1(mapcar’-pt’(1.0 1.0 0.0))pt2(mapcar’+pt’(1.0 1.0 0 0.0))curFil(list’(0。“POINT”)(assoc 8 filLst2))errCount 0);结束setq(if(setq ptSet(ssget“_”pt1 pt2 curFil))(progn(if(=1(sslength ptSet))(progn(setq wPt(ssname ptSet 0)bsPos(trans(cdr(assoc 10(entget wPt)))0 1)deVal(mapcar'-pt bsPos));结束setq(cond((和(

jason tay 发表于 2022-7-5 16:20:59

阿斯米,首先感谢你。。一旦我完成手头的紧急工作,我就会试一试

jason tay 发表于 2022-7-5 16:22:01

阿斯米,这个Lisp程序看起来很棒,但是为什么我在最后一次尝试它呢?它会弹出并“输入属性”询问VALUET和VALUEL(我尝试了你写的第一个Lisp程序也会弹出相同的东西)?
另一件事,最终的结果能否不以方块形式出现?

ASMI 发表于 2022-7-5 16:27:16

设置ATTDIA=0。我不知道这个变量。我可以用ATTREQ=1变量将其添加到代码中。但首先要寻找其他bug。

ASMI 发表于 2022-7-5 16:31:05

使用ATTDIA和ATREC更改、恢复和比较图形(手动旧图形和使用此程序的新图形)进行编码。
 
(defun c:偏差(/ABPNT ACTDOC BLPATH BSPOS CURFIL CURPT DEVAL FILLST FILLST1 FILLST2 INPT INSBL INSPT OFFLST oldcho OLDOSN PLBLK PPLIST PT1 PT2 PTLST PTSET WPT WRKSET ERRCOUNT VARLST OLDVARS*ERROR*)(vl load com)(defun*ERROR*(msg)(if OLDVARS(mapcar的setvar VARLST OLDVARS));结束if(if actDoc(vla EndUndoMark actDoc));结束if(princ));结束*错误*(if(and(setq plBlk(entsel“\n点击‘pile’block>”)(=“INSERT”(cdr(assoc 0(setq filLst1(entget(car plBlk)))))));结束和(progn)(如果(和(setq abPnt(entsel“\n点击‘竣工’点>”)(=“点”(cdr(assoc 0(setq filLst2(entget(car abPnt)))))));end和(progn(setq filLst(list’(0。“INSERT”)(assoc 2 filLst1))(while(setq curPt(getpoint“\n指定‘建议的点’或空格键以继续>”))(setq ppList(append(list curPt)ppList));结束while(if ppList(progn(princ“\n>”)(if(setq wrkSet(ssget filLst))(progn(setq wrkSet(vl remove if‘listp(mapcar’cadr(ssnamex wrkSet)))offLst(mapcar’-(lambda(x)(mapcar’-(trans(cdr(assoc 10 filLst1))0 1)x))ppList(list“CMDECHO”“OSMODE”“ATTDIA”“ATTREQ”)oldVars(mapcar‘getvar varLst)actDoc(vla get ActiveDocument(vlax get acad object));end setq(vla StartUndoMark actDoc)(mapcar“setvar varLst”(0 0 1))(foreach pl wrkSet(setq insPt(trans(cdr(assoc 10(entget pl)))0 1)ptLst(reverse(mapcar)(λ(x)(mapcar’+insPt x))offLst));结束setq(foreach pt ptLst(setq pt1(mapcar’-pt’(1.0 1.0 0.0))pt2(mapcar’+pt’(1.0 1.0 0 0.0))curFil(list’(0。“POINT”)(assoc 8 filLst2))errCount 0);结束setq(if(setq ptSet(ssget“_”pt1 pt2 curFil))(progn(if(=1(sslength ptSet))(progn(setq wPt(ssname ptSet 0)bsPos(trans(cdr(assoc 10(entget wPt)))0 1)deVal(mapcar'-pt bsPos));结束setq(cond((和(
页: 1 [2]
查看完整版本: 竣工打桩