在多段线上绘制链测长度
大家好任何人都可以帮助在多段线上绘制等距的链测长度,如所附的jpg中所示吗
我相信这已经讨论过几次了,并且已经发布了例行程序。尝试搜索“站点”,这是美国相当于“链测长度”。 您好,您可以使用block,在block中创建一条线,然后使用measure命令,键入block、block name并根据您想要的测量创建链测线。
希望能有所帮助:_) 也许这个-?
http://www.cadtutor.net/forum/showthread.php?t=3876
或者,DC_链http://afralisp.net/lisp/dctools.htm 我太忙了,没法重写它
满足您的确切需求,但希望如此
会让你开始的
(defun div error(msg)(if(vl position msg)(“控制台中断”函数取消“退出/退出中止”))(princ“error!”)(princ msg))(while(>(getvar“cmdactive”)0)(命令));;;(命令“_undo”“_end”);;;(命令“_”)(setq*error*olderror)(princ))(defun divplus(len segm/num lst)(setq num(fix(/len segm)))(setq cnt 0)(while(=len 0。)(setq lst(append lst(list len))(setq len(-len segm)))(if(not(zerop(last lst)))(setq lst(append lst(list 0.0)))lst)(defun alg ang(obj pnt)(角度'(0.0.0。)(vlax curve getfirstderiv obj(vlax curve getparamatpoint obj pnt))(defun answer(quest/wshl ans)(或(vl load com))(setq wshl(vlax get或create object“WScript.Shell”))(setq ans(vlax invoke method wshl’Popup quest 7)回答这个问题:“vlax vbYesNo”)(vlax release object wshl)(cond((=ans 6)(setq opt T))(=ans 7)(setq opt nil)))opt)(defun make station(bname/acsp adoc atprom attag at_obj blk\u obj hgt lay line\u obj sfar)(vl load com)(setq adoc(vla get activedocument(vlax get acad object))(if(and(=(getvar“tilemode”)0)(=(getvar“cvport”)1))(setq acsp(vla get paperspace adoc))(setq acsp(vla get modelspace adoc))(vla startundomark adoc)(if(not)(tblsearch“block”bname))(progn(setq attag“NUMBER”;(strcase(getstring“\n属性标记:\n”))atprom“NUMBER”;(strcase(getstring T“\n属性提示:\n”))hgt 1.0;(getreal“\n属性文本高度:”)(setq lay(getvar“clayer”))(setvar“clayer”0”)(setvar“attreq”0)(setq line\u obj(vlax invoke acsp“Addline”(0.0.0)(列表0。(*hgt 12。)(vla put color line\u obj acyellow)(setq blk\u obj(vla add(vla get blocks adoc)(vlax-3d-point’(0.0.0))bname)sfar(vlax safearray fill(vlax make safearray vlax vbObject’(0.0))(list line_obj))(vla copyobjects adoc sfar blk_obj);;;RetVal=对象。AddAttribute(高度、模式、提示、插入点、标记、值)(setq at_obj(vla AddAttribute blk_obj hgt acattributemodemodedeverify atprom(vlax-3d-point’(-0.5 1.0))附件“0+00”);;;(vla将对齐放在_obj acAlignmentBottomCenter);;;(vla put textalignmentpoint;;;at_obj;;(vlax-3d-point’(0.1.0);;;)(vla put rotation at_obj(/pi 2))(vlax release object blk_obj))(progn(princ“\n\t>>块已存在!\n”)(princ))(if(tblsearch“Block”bname)t(progn(alert“不可能添加块”))(setvar“attreq”1)(setvar“clayer”lay)(vl catch all apply(函数(lambda()(vla delete line\u obj))))(vla regen adoc acactiveviewport)(vla endundomark adoc)(vlax release object acsp)(vlax release object adoc)(princ))(或(vl load com))(defun C:d10(/*error*acsp adoc appd div error len num olderror pl pt pt_list step util)(或adoc(setq adoc(vla get activedocument(vlax get acad object)))(或appd(setq appd(vla get application adoc)))(或acsp(setq acsp(vla get block(vla get activelayout adoc)))(或util(setq util(vla get utility adoc)));;;(命令“_undo”“_end”);;;(命令“_undo”“_mark”)(setq olderror*error*)(setq*error*div error);;;(setq bname(getstring T“\n站块名:\ n”);;;(make station bname)(if(not(tblsearch“block”“station”)(make station“station”))(vla getentity util“pl”pt“\n选择要开始测量的点附近的线:>>>>)(if pl(progn(setq step(getreal”\n用于定位的另一个步骤:\ n))(setq opt(回答“垂直于柱脚旋转文本?”)(如果(非步骤)(setq步骤10)(setq len(vlax curve getdistatparam pl(vlax curve getendparam pl))(if(<(distance(vlax safearray->list pt)(vlax curve getstartpoint pl))(distance(vlax safearray->list pt)(vlax curve getendpoint pl))(setq pt\u list(divplus len step))(setq pt\u list(divplus len step)))(setq pt_list(vl remove if(function not)(mapcar(function(lambda(x)(vlax curve getpointatdist pl x)))pt_list))(setq num 0);;;(setq num(getint“\n输入初始站号”)(mapcar(函数(lambda(x/dr ang att\u list at blk\u obj)(progn(setq ang(alg ang pl x)ang(cond((<(/pi 2)ang(*pi 1.5))(+pi ang))(T ang))(setq blk\u obj(vlax invoke acsp'Insertblock x“station”1 1 ang))(setq att\u list(vlax invoke blk\u obj'Getattributes))(foreach at att\u list(if(eq(vlax get at'Tagstring)“NUMBER”)(progn(vlax put at'Textstring(if(<num 990))(strcat“sta:0+”(rtos num 2))(strcat“sta:”(itoa(fix(/num 1000)))[颜色=红色]; 谢谢你,我只想解释一下我的想法
你的路线很好,但当测量达到千分之一时,这里有错误,所以总长度不正确,请修改它
谢谢
对不起,我现在很忙
也许,以后我能做到
~'J'~ 忘了说
我不想处理你的照片
上传你的真实工作图
那会更容易帮助你
~'J'~ 谢谢菲索的帮助
感谢carlB的链接,它准确地解决了我需要的问题 谢谢你的精彩表演。
如果有人能帮我的话,我需要在例程中改变什么,将链测长度的文本旋转180度。
非常感谢
辛姆罗
页:
[1]
2