ryan sen 发表于 2022-7-6 14:23:42

测量命令代码

我对AutoCAD VBA很陌生，虽然我对VB 6.0编程有一些了解，对AutoCAD也很熟悉。是否可以使用AutoCAD VBA执行“测量”命令。

BIGAL 发表于 2022-7-6 14:52:05

您应该能够访问任何autocad命令
此图纸。SendCommand“measure”和vbCr
 
如果您知道拾取点和距离，请使用vbCr添加到以上内容（&V）
 
不过，最好看看这里的众多“测量”（沿普林线的距离）示例，因为你很可能会在以后想要更智能、更复杂的东西。

ryan sen 发表于 2022-7-6 14:57:55

嗨，比格尔，我搜索了一些听起来像“measure”的代码。我想我需要这样的代码，如下所示：
 
（defun div error（msg）（if（vl positionmsg）（“控制台中断”函数取消了“退出/退出中止”））（princ“error！”）（princ msg））（while（>（getvar“cmdactive”）0）（command））（command“.u undo”“\u end”）（command“.u u”）（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）（vl load com）（提示“\n***键入D50以执行***\n”）（defun C:D50（/*error*acsp adoc ang appd cntdiv error head len olderror plpt pt pt pt\u list rad step st\u list st\u num st\u txttht util）（或adoc（setq adoc（vla get activedocument）（vla）x 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）））（命令“.u undo”“\u end”）（命令“.u undo”“\u mark”）（setq olderor*error*）（setq*error*div error）（setq step 50.head“10+”；（getstring T“\n输入标签前缀：”）tht 2.5；（getreal“\n输入文本高度：”）rad 1。；（getreal“\n圆半径：”）（vla-getentityutil'pl'pt”\n选择线开始标记附近的线：>>>）（if pl（progn（setq len（vlax curve getdistatparampl（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（divminus len step）））（setqpt\u list（vl remove if（function not）（mapcar（function（lambda（x）（vlax curve getpointatdist pl x））pt\u list））（setq ang（angle（car pt\u list）（cadr pt\u list））ang（cond（（<（/pi 2）ang（*pi 1.5））（+pi ang））（T ang））（setq cnt-1）（repeat（length pt\u list）（setq cnt（1+cnt））（setq st\u num（cond（（<cnt 10）（strcat head“0”（itoa cnt））））（T（strcat头（itoa cnt kа））（setq st_列表（cons st_num st_列表）））（setq st_列表（反向st_列表））；；以下删除如果不需要>>>（mapcar（函数（lambda（x）（vla addcircle acsp（vlax-3d-point x）rad）））pt_列表）；>（vlax put property st_txt’Rotation ang）（vla update st_txt）；list pt）（vlax curve getstartpoint pl））（distance（vlax safearray->list pt）（vlax curve getendpoint pl））（setq pt_list（divplus len step））（setq pt_list（divminus len step））（setqpt_list（vl remove if（function not）（mapcar（function（lambda（x）（vlax curve getpointatdist pl x）））pt_list））（setq ang（angle（car pt_list）（cadr pt_list））ang（cond（（<（/pi 2）ang（*pi 1.5））（+pi ang））.（T ang））（setq cnt-1）（repeat（length pt_list）（setq cnt（1+cnt））（setq st_num（cond（<cnt 10）（strcat head“0”（itoa cnt）））（T（strcat head（itoa cnt）аа））（setq st_list（cons st_num st_list）））（setq st_list（reverse st_list））；；以下删除如果不需要>>>（mapcar（函数（lambda（x）（vla addcircle acsp（vlax-3d-point x）rad）））pt_列表）；>（vlax put property st_txt’Rotation ang）（vla update st_txt）；

BIGAL 发表于 2022-7-6 15:20:13

查看最近的帖子“多段线上的点”“分割多段线”的文字，大意是这里有很多例子在做不同的事情vba和lisp也“batter”，我从这里得到一个程序沿pline计算点。

ryan sen 发表于 2022-7-6 15:33:13

嘿，谢谢Bigal，我试着根据你建议的关键字搜索，我发现了你的一个代码：
 
http://www.cadtutor.net/forum/showthread.php?t=28376
 
 
从这里我可以理解的是，它检索多段线的所有坐标，间隔决定了将插入每个段内的块的数量。
 
我可以修改这段代码，使其像measure命令一样使用吗。哪里都有，我需要修改。
 
还有一件事，你是如何决定startang和endang的常数的？
 
谢谢！！
赖安
页: [1]
查看完整版本: 测量命令代码