更新a。lsp帮助

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

我找到了一个例程来帮助我创建一个表。我在一条线上有点编号，我需要一个表格来显示这两个点编号之间的方位/距离。该表需要如下所示：

航程轴承
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

copy

(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)
)