在多段线上绘制链测长度

motee-z · 发表于 2022-7-5 15:47:55

大家好
任何人都可以帮助在多段线上绘制等距的链测长度，如所附的jpg中所示吗

CarlB · 发表于 2022-7-5 15:53:48

我相信这已经讨论过几次了，并且已经发布了例行程序。尝试搜索“站点”，这是美国相当于“链测长度”。

jason tay · 发表于 2022-7-5 15:57:14

您好，您可以使用block，在block中创建一条线，然后使用measure命令，键入block、block name并根据您想要的测量创建链测线。

希望能有所帮助：_）

CarlB · 发表于 2022-7-5 15:58:19

也许这个-？

http://www.cadtutor.net/forum/showthread.php?t=3876

或者，DC_链http://afralisp.net/lisp/dctools.htm

fixo · 发表于 2022-7-5 16:01:09

我太忙了，没法重写它
满足您的确切需求，但希望如此
会让你开始的

[code]（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）））[颜色=红色]；