(求助)麻烦大神看一下，能不能帮小弟实现定距等分的问题
本帖最后由 999999 于 2024-7-30 14:16 编辑又来论坛上打扰各位大神啦，这次需要的是一个小功能，定距等分，CAD自带的不好用
看看有没有大神能够帮小弟解决这个问题的
感谢大家啦，虽然我没有为论坛做贡献，我一直都要提问题，和要求，但是我想的是，小功能提出问题来，大神们能帮忙解决，对于论坛本身来说，也是完善各种小插件的需求，对于有同样需要的小伙伴来说，也是一种帮助，一问一答，这样的论坛就多姿多彩，不啰嗦啦，直接进入主题
等距等分:
1.输入命令
2.选择需要等分的线
3.输入需要等分的块名或空格选择块（带记忆功能记住块的名字）：AA
4.输入块的间距（或鼠标量间距）带记忆功能：40
5.输入块中心点与点击线段端点的距离（或鼠标量间距）带记忆功能：10
如果没有输入距离的话，就默认块中心点与点击线段端点距离为0
6.生成结果
感谢大神们的耐心观看，如果有时间的话，希望大神们可以帮帮小弟实现这个功能，谢谢啦
今天在论坛找到了一个和我需要的效果一样的，http://bbs.mjtd.com/thread-101300-1-1.html?_dsign=d2c50e25 这个插件目前就是缺少记忆功能，和可以输入块名的功能，看看大神们能不能帮忙完善一下。
写这个插件的大神是论坛里的 自贡黄明儒 大神
本帖最后由 llsheng_73 于 2024-12-21 18:14 编辑
(defun makedcl(str_lst / dclfile fileID dclHandle)
(setq dclfile(vl-filename-mktemp nil nil ".dcl")fileID(open dclfile "w"))
(write-line(apply'strcat str_lst)fileID)
(close fileID)
(setq dclHandle(load_dialog dclfile))
(vl-file-delete dclfile)
dclHandle)
(defun c:TT(/ dcl blocks e dist d a jl l km *model)
(vl-load-com)
(setq dcl(makedcl'("DFX:dialog{label=\"等分线\";key=\"AAA\";"
":column{:popup_list{label=\"块名\";key=\"KM\";width=20;}:row{:button{key = \"SE\";label=\"...\";}:edit_box{label=\"缩放比例\";key=\"BL\";}}"
":edit_box{label=\"插入间距\";key=\"JL\";}:edit_box{label=\"偏距(左+右-)\";key=\"D\";}"
":row{:button{key = \"ESC\";label = \"放弃\";is_cancel = true;}:button{key = \"DO\";label=\"执行\";}}}}"))
*model(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activedocument)'modelspace)
ctl 4)
((lambda(/ a)(While(SetQ a(TblNext "block"(not blocks)))(SetQ blocks(Cons(Cdr(Assoc 2 a))blocks)))))
(vl-every(function(lambda(a b)(set(read a)b)))(setq keys'("KM""BL""JL""D"))(vlax-ldata-get"上次记忆""参数"))
(while(> ctl 1)
(new_dialog"DFX"dcl)
(start_list"KM")(vl-every(function add_list)blocks)(end_list)
(set_tile"LH"(if l(strcat"线长"(rtos l 2 2))"未选择"))
(and km(set_tile"KM"(itoa(vl-position km blocks))))
(vl-some(function(lambda(a b)(and b(set_tile a b)nil)))(cdr keys)(list bl jl d))
(action_tile"SEL""(done_dialog 2)")(action_tile"SE""(done_dialog 2)")
(action_tile"BL""(IF(or(NOT(DISTOF $VALUE))(<=(DISTOF $VALUE)0))(PROGN(ALERT\"只允许数值且大于0!\")(MODE_TILE\"BL\"2))(setq bl $VALUE))")
(action_tile"JL""(IF(or(NOT(DISTOF $VALUE))(<=(DISTOF $VALUE)0))(PROGN(ALERT\"只允许数值且大于0!\")(MODE_TILE\"JL\"2))(setq jl $VALUE))")
(action_tile"D""(IF(NOT(DISTOF $VALUE))(PROGN(ALERT\"只允许数值!\")(MODE_TILE\"D\"2))(setq d $VALUE))")
(action_tile"DO""(SETQ VALUE(CONS(NTH(ATOI(GET_TILE\"KM\"))blocks)(MAPCAR(function GET_TILE)'(\"BL\"\"JL\"\"D\"))))(done_dialog 1)")
(cond((= (setq ctl(start_dialog)) 2)
(prompt"\n点选要插入的参照")
(and(setq a(ssget":E:S"'((0 . "insert"))))
(setq a(ssname a 0))
(setq km(cdr(assoc 2(entget a))))))
((= ctl 1)
(vl-every(function(lambda(a b c)(set(read a)(b c))))keys(list princ distof distof distof)value)
(vlax-ldata-put"上次记忆""参数"VALUE)
(while(progn(prompt"\n点选要等分的线")
(and(setq e(ssget":E:S"'((0 . "*polyline,arc,circle,ellipse,spline"))))
(setq e(ssname e 0))
(setq L(-(vlax-curve-getdistatparam e(vlax-curve-getendparam e))(vlax-curve-getdistatparam e(vlax-curve-getstartparam e))))))
((lambda(/ p ang)(setq a(- jl))
(while(<(setq a(+ a jl))l)
(setq p(vlax-curve-getpointatdist e a)
ang(angle'(0 0)(vlax-curve-getFirstDeriv e(vlax-curve-getparamatpoint e p)))
p(polar p(+(* pi 0.5)ang)d))
(vlax-invoke-method *model'insertblock(vlax-3d-point p)km bl bl 1 ang)))))))
)) 试一下新版的ARRAY，可以沿路径 kozmosovia 发表于 2024-7-29 19:21
试一下新版的ARRAY，可以沿路径
大神您好，这个命令我刚刚试了一下哦，不理想哦 看上去不简单啊;P
muai2010 发表于 2024-7-29 20:42
看上去不简单啊
那确实是，哈哈，懂的人觉得简单，不懂人的觉得难，我是属于第二者 本帖最后由 999999 于 2024-7-30 14:55 编辑
ssyfeng 发表于 2024-7-30 10:32
大神，您好，看您的操作是这样的效果呢。可以方便提供吗？ 999999 发表于 2024-7-30 14:12
大神，您好，看您的操作是这样的效果呢
大神您好，这个可以方便提供吗？ 大神您好，这个可以方便提供吗？