高程点自动移位ObjcetARX版

cuyong123

gzxl 发表于 2012-12-31 05:35
其实没什么技术含量，很简单 看下图就明白了

gzxl老师，能不能发这个程序给我啊！下手慢，什么都没有捞到！能发我一个吗？253406939@qq.com

杜阳

挺好的程序  为啥要作废呢  

bmy07

这个程序老早就在论坛里就有了，根本不能完全符号地形图的移位标准，判断不全

911363361

在那里啊，有没有软件件啊

杜阳

gzxl 发表于 2012-12-31 17:34
你想达到什么效果？难道你有更好的方法？
源码都已附上，想快的话可以修改移动步距

楼主 代码怎么没有了  你这个速度快多了  能否重新发一下啊

jxy308

怎么不见了

gzxl

忘了上传附件了

jactry

码在哪里啊

sunqv

楼上大大可以写个物探点号的移位源代码吗？

或者帮忙改下下面这段代码

(defune:auto()
(vl-load-com)
(setvar"lispinit"0)
(setvar"cmdecho"0)
(setqstext(ssget"X"(1ist(cons0"TEXT")(cons8"
1'ExT")(cons7"GXT"))))
;选取管线图上点号创建选择集
(if(/=stextnil)
(progn
(setqn(sslengthstext)i0)
(repeatn
(setqenamet(ssnainestexti))
(setqi(1+i))
(setqtxtdt(entgetenamet))
(setqtxt(cdr(assoc1txtdt)));取管线点号的属标志
(setqtxtl(substrtxt12));取点号的前两个字符,后面需判断为YS,WS还是HS
(eond
((=txtl"YS");当管线点号为雨水时
(pmgn
(setqspoint(ssget"X"(1ist(cons0"INSERT")(cons8"
YSPOINT"))))
;选取所有雨水管线点创建选择集
(if(/=spointnil)
(progn
(setqm(sslengthspoint)k0)
(repeatm
(setqenamep(ssnamespointk))
(setqk(1+k))
(setqtsdh(xdataenamep5));调用xdata函数获取管线点的扩展数据"图上点号"
(setqwtdh(xdataenamep7));调用xdata函数获取管线点的扩展数据"物探点号"
(if(=tsdhtxt);判断为T,则找到管线点号所对应的管线点
(progn
(setqsline(ssget"x"(1ist(cons0"LINE")(cons8"YS-
LINE"))))
;选取所有雨水管线段创建选择集
(if(/=slinenil)
(progn
(setql(sslengthsline)jO)
(repeatl
(setqenamel(ssnameslineJ))
(setqj(1+j))
(setqqswh(xdataenamel5));调用xdata函数获取管线段的扩展数据"起始物号"
(setqzzwh(xdataenamel7));调用xdata函数获取该管线段的扩展数据"终止物号"
(if(or(=qswhwtdh)(=zzwhwtdh));判断为T,则找到与管线点相关的管线段
(pmgn
(setqfsw(xdataenamep11));调用xdata函数获取管线点的扩展数据"附属物"
(setqtz(xdataenamep9));调用xdata函数获取管线点的扩展数据"特征"
(setqintptx(cadr(assoc10(entgetenamep))))
(setqintpty(caddr(aSSOClO(entgetenamep))))
(setqintpL(1istintptxintpty));获取管线点的插入点坐标
(setqlx(::dataenamel21));调用xdata函数获取管线段的扩展数据"流幻"
(cond
((=fsw'雨水篦");附属物为雨水篦,则以下面语句移位管线点号,然F捕捉异常,退出循环,提高程序效率,因lisp语言没有从循环眺出继续往下执行的语句
(progn(mDyeenamellx01.8)(setqpdnil)(d-catch—au—
apply(1ambda()(if(=pdnil)(exit))))));move函数的后两个参数可以根据实际需要修改,0为旋转角度,1.8为距离管线点的距离
((and(=fsw"检查井")(=tz"三通"))
;附属物}三通检查井,管线点号移位到没有管线的一侧
(progn
(setqeobjl(vlax—ename->vla-objectename1))
(setqline:h(vla—get—lengtheobj1))
(vlax-rehase-objecteobj1)
(if(and(::zzwhwtdh)(=lx"0")(<lineth10))
(moveentimellxpi1.2))
(setqpd1Lil)
(vl-catch—all-apply(1ambda()(if(=pdnil)(exit))))))
((and(=fsw"检查井")(or(=tz"四通")(=tz"五
通")(=tz"9"'7通")))
;附属物四通,五通或者六通检查井,则移位到没有管线处
(progn(m)veenamellx0.752)(setqpdnil)(d-catch—all—
apply(1ambda()(if(=pdnil)(exit))))))
((or(=t:"非普查区")(:tz"预留口"))
;管线点特征为非普查区或预留口,移位到插入点的末端
(progn(m,weenamellx05)(setqpdnil)(vl—catch-all-ap?
ply(1ambda(:(if(=pdnil)(exit))))))
((=tz"出水口");管线点特征为出水口,移位到插入点的末端
(progn(m-)veenamellxpi2.4)(setqpdnil)(vl-catch-all-
apply(1ambda()(if(=pdnil)(exit))))))
((=tz"进水口");管线点特征为进水口,移位到插入点的末端
(progn(m,)veenamelIx02.4)(setqpdnil)(vl-catch—all-
apply(1ambda)(if(=pdnil)(exit))))))
((or(=fiw"检查井")(=tz"三通")(=tz"转折点")
(=tz"一般点")(=tz"四通")(=tz"五通")(=tz"六通")
(:tz"特征点"))
;管线点特征为以上情况之一,移位到插入点的一侧
(progn(m,~veenamellxpi2)(setqpdnil)(vl—catch-all-ap—
ply(1ambda()(if(=pdnil)(exit)))))))))))))))))))
((=txtl'WS")(progn));与YS设计思路一致
((=txtl'HS")(progn))))));与YS设计思路一致
(setvar"cmdecho"1)
(alert"点号移动结束!")
(princ))
;获取扩展数据函数
(defunx&~ta(enamexth/eobjdatatypedataxdata)
(setqeobj:vlax—ename->vla—objectename))
(setqdataype(vlax—make—safearrayvlax—vbinteger(0.
1)))
(setqdata(vlax—make-safearrayvlax—vbvariant(O.1)))
(vla-getxdataeobj"""datatype"data)
(vlax-release-objecteobj)
(setq
xdat(vlax—variant—value(vlax—safearray—get—elementdata
xth))))
;计算管线点号的中心对齐点并修改点号的中心对齐点函数
(defunmove(enamelxadddist/eobjlanglesintptxsd)
(if(/:lxnil)
(progn
(setqeobjl(vlax—ename->vla-objectename1))
(if(=lx"0")
(setqangles(+(via-get-angleeobj1)pi))
(setqangles(vla—get—angleeobj1)))
(vlax-release-objecteobj1)
(setqintptx(polarintpt(+anglesadd)dist))
(setqsd(subst(cons11intptx)(assoc11txtdt)txtdt))
(entmodsd))))

gzxl

jactry 发表于 2015-10-6 11:42
码在哪里啊

http://bbs.mjtd.com/thread-169751-1-1.html