社区 › Auto Lisp › 更新a。lsp帮助

mnyrac 发表于 2022-7-5 23:35:11

更新a。lsp帮助

我找到了一个例程来帮助我创建一个表。我在一条线上有点编号，我需要一个表格来显示这两个点编号之间的方位/距离。该表需要如下所示：
 
航程轴承
1000-1001 XX'xxdxx'XX“
 
我找到的程序几乎完成了我想做的一切。除了它只允许我从第1点开始，而不是从1000点开始。它做的另一件事是“关闭”系统。例如，当我选择点1、2、3、4时；它给了我一个1-2，2-3，3-4和4-1的课程表。我不想在最后结束。
 
有人能帮我修改一下吗。lsp文件来实现这一点？我对定制知之甚少。
 
（vl load com）
（定义C：轴承（/*错误*acsp ang atable cnt col dist item osm
点列表pt row table\U data tmp tmp\U data
degreeloc minuteloc secondloc AngString）
 
（defun*错误*（msg）
（如果（和消息
（不是
（成员消息
“（“控制台中断”函数已取消“退出/退出中止”）））
（princ（strcat“\n错误：“msg”）
)
（如果osm
（setvar“osmode”osm）
（普林斯）
)
 
（setq osm（getvar“osmode”））
（setvar“osmode”1）
 
（setq cnt 1）
（while（setq pt（getpoint
（strcat“\n>>指定点#”
（itoa cnt）
“按顺序（点击回车退出）>>”）
（setq point_列表（cons pt point_列表）
碳纳米管（1+碳纳米管））
)
（setq point_列表（反向point_列表））
 
（setq cnt 0）
（虽然(
（setq tmp（列表（strcat（itoa（1+cnt））”-（itoa（+cnt 2）））
（第n个cnt点列表）
（第n（1+cnt）点列表）
tmp_数据（cons tmp tmp_数据）
)
（setq cnt（1+cnt））
)
（setq tmp（列表（strcat（itoa（长度点_列表））“-1”）
（最后一点列表）
（car point_列表）
tmp_数据（cons tmp tmp_数据）
)
（setq tmp_数据（反向tmp_数据））
 
（每个项目tmp_数据
（setq ang（angtos（角度（cadr项目）（caddr项目））4）
degreeloc（vl字符串位置（ascii“d”）ang）；“d”的位置
minuteloc（vl字符串位置（ascii“”）ang）；'
secondloc（vl字符串位置（ascii“\”）ang）；位置“
);setq公司
（如果（（-minuteloc degreeloc）2）
（setq ang（vl string subst“d0”“d”ang））；10秒以下加0
);如果
（if（（-secondloc minuteloc）2）
（setq ang（vl string subst“'0”“'”ang））；在10分钟内添加0
);如果
（setq AngString（vl string subst“°”d”ang）；替换度符号
距离（距离（cadr项目）（caddr项目））
dist（strcat（rtos dist 2 2）“'”）
tmp（列表（车辆项目）和字符串距离）
table_数据（cons tmp table_数据）
);setq公司
);foreach公司
 
（setq）
table_数据（反向table_数据）
pt（getpoint“\n>>指定插入点>>”）
acsp（vla get block
（vla get activelayout
（vla获取activedocument
（vlax get acad object）））
 
atable（vlax invoke acsp’AddTable pt
（+2（长度表数据））
（长度（car table_数据））
（*（getvar“textsize”）2.0）
（*（getvar“textsize”）15）
);setq公司
（vla put REGENATITABLESUPPRESSED atable:vlax true）
（vla settextheight atable actitlerow（getvar“textsize”））
（vla settextheight atable acheaderrow（getvar“textsize”））
（vla settextheight atable acdatarow（getvar“textsize”））
（vla put VERTCELLMARRING atable（/（getvar“textsize”）4.25））
（vla settext atable 0 0“课程表”）
（vla settext atable 1 0“课程”）
（vla settext atable 1 1“轴承”）
（vla settext atable 1 2“距离”）
（setq第2行）
（foreach item table_数据
（setq列0）
（外汇x项目
（vla settext atable row col x）
（vla setcellalignment atable row col acMiddleCenter）
（setq列（1+列）））
（setq行（1+行））
)
 
（vla put REGENATITABLESUPPRESSED atable:vlax false）
 
（*错误*无）
 
（普林斯）
)

alanjt 发表于 2022-7-5 23:40:13

请使用代码标签。这是编辑中的英镑符号。

mnyrac 发表于 2022-7-5 23:43:43

(vl-load-com)
(defun C:Bearings (/ *error* acsp ang atable cnt col dist item osm
point_list pt row table_data tmp tmp_data
degreeloc minuteloc secondloc AngString)

(defun *error* (msg)
(if (and msg
(not
(member msg
'("console break" "Function cancelled" "quit / exit abort"))))
(princ (strcat "\nError: " msg))
)
(if osm
(setvar "osmode" osm))
(princ)
)

(setq osm (getvar "osmode"))
(setvar "osmode" 1)

(setq cnt 1)
(while (setq pt (getpoint
(strcat "\n >> Specify point #"
(itoa cnt)
" by order (hit Enter to exit) >> ")))
(setq point_list (cons pt point_list)
cnt (1+ cnt))
)
(setq point_list (reverse point_list))

(setq cnt 0)
(while (<= cnt (- (length point_list) 2))
(setq tmp (list (strcat (itoa (1+ cnt)) " - " (itoa (+ cnt 2)))
(nth cnt point_list)
(nth (1+ cnt) point_list))
tmp_data (cons tmp tmp_data)
)
(setq cnt (1+ cnt))
)
(setq tmp (list (strcat (itoa (length point_list)) " - 1")
(last point_list)
(car point_list))
tmp_data (cons tmp tmp_data)
)
(setq tmp_data (reverse tmp_data))

(foreach item tmp_data
(setq ang (angtos(angle (cadr item) (caddr item))4 4)
degreeloc (vl-string-position (ascii "d") ang);location of "d"
minuteloc (vl-string-position (ascii "'") ang);location of '
secondloc (vl-string-position (ascii "\"") ang);location of "
);setq
(if (= (- minuteloc degreeloc) 2)
(setq ang (vl-string-subst "d0" "d" ang));add 0 for seconds under 10
);if
(if (= (- secondloc minuteloc) 2)
(setq ang (vl-string-subst "'0" "'" ang));add 0 for minutes under 10
);if
(setq AngString (vl-string-subst "°" "d" ang);Substitute degree symbol
dist (distance (cadr item) (caddr item))
dist (strcat (rtos dist 2 2) "' ")
tmp (list (car item) AngString dist)
table_data (cons tmp table_data)
);setq
);foreach

(setq
table_data (reverse table_data)
pt (getpoint "\n >> Specify insertion point >> ")
acsp (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object))))

atable (vlax-invoke acsp 'AddTable pt
(+ 2 (length table_data))
(length (car table_data))
(* (getvar "textsize") 2.0)
(* (getvar "textsize") 15))
);setq
(vla-put-regeneratetablesuppressed atable :vlax-true)
(vla-settextheight atable actitlerow (getvar "textsize"))
(vla-settextheight atable acheaderrow (getvar "textsize"))
(vla-settextheight atable acdatarow (getvar "textsize"))
(vla-put-vertcellmargin atable (/ (getvar "textsize") 4.25))
(vla-settext atable 0 0 "COURSE TABLE")
(vla-settext atable 1 0 "COURSE")
(vla-settext atable 1 1 "BEARING")
(vla-settext atable 1 2 "DISTANCE")
(setq row 2)
(foreach item table_data
(setq col 0)
(foreach x item
(vla-settext atable row col x)
(vla-setcellalignment atable row col acMiddleCenter)
(setq col (1+ col)))
(setq row (1+ row))
)

(vla-put-regeneratetablesuppressed atable :vlax-false)

(*error* nil)

(princ)
)

alanjt 发表于 2022-7-5 23:46:08

我本想编辑你的第一篇帖子。不要介意。
 
您是否无法在civil 3d中完成此操作？它有许多漂亮的直线/圆弧表选项。

mnyrac 发表于 2022-7-5 23:48:20

你在和一个Lisp程序的业余爱好者说话。我花了一段时间才明白你所说的代码标签是什么意思。
 
据我所知，您只能通过使用线标记而不是点来实现这一点。我做了很多研究，似乎没有一个可靠的答案，除非你能在2013年做到。

fabriciorby 发表于 2022-7-5 23:52:16

作为一名lisp定制爱好者，并不意味着你无法阅读以下内容：
http://www.cadtutor.net/forum/showthread.php?9184-代码发布指南
 
但是，nvm哈哈

mnyrac 发表于 2022-7-5 23:56:15

好吧，好吧，所以我没有读完整的论坛怎么做。除了继续评论我缺乏程序，有人能回答这个问题吗？

pBe 发表于 2022-7-6 00:00:28

 
现在，没有必要让mnyrac生气。当然有人可以。
 
你这是什么意思
 
 
这是否意味着只有3段？
1000-1001
1001-1002
1002-1003
 
请务必包括代码的作者或您找到例程的链接。
 
欢迎来到mnyrac论坛

mnyrac 发表于 2022-7-6 00:03:11

谢谢
 
是的，这就是我的意思。该例程也不允许我选择自己的点数（总是从点1开始）。
 
我至少在一两个月前发现了这种习惯，当然我不记得在哪里了。

pBe 发表于 2022-7-6 00:04:21

 
那好吧。明天我会发布代码[已经准备好修改代码，但我在办公室写了回来]。
真的很简单。如果你能等到那时。
 
否则，其他论坛成员将为您修复代码，然后您可以按字母顺序说出美国所有50个州，但颠倒过来。
 

查看完整版本: 更新a。lsp帮助