ＳＯＳ：ＬＩＳＰ程序请教（一次性获取两相交线节点坐标)
<p></p><p>各位大哥：</p><p>新年好！</p><p>图中红色为生成的线，黄色的为我画上去的线条，我想用ＬＩＳＰ编一程序,可生成能"获取黄色线节点坐标"（纵横两线交点）程序，生成最好系ＴＸＴ文本格式，有哪位兄弟能帮上这个忙吗？谢谢！</p><p> </p> 本帖最后由 作者 于 2007-3-1 17:51:32 编辑我的理解是:你希望求出红线与所有白线的交点,生成黄线和坐标文本,
如果我的理解没有错,程序如下:
(DEFUN c:tmp (/ ENT1 ENT2 N PT PTS SSG FILE)
(vl-load-com)
(SETQ ent1 (VLAX-ENAME->VLA-OBJECT (CAR (ENTSEL "\n选取一根红线:"))))
(PRINC "\n选取一组竖向坐标线:")
(SETQ ssg (SSGET '((0 . "LINE"))))
;;获取交点集
(SETQ pts nil)
(REPEAT (SETQ n (SSLENGTH ssg))
(SETQ ent2 (VLAX-ENAME->VLA-OBJECT (SSNAME ssg (SETQ n (1- n)))))
(IF (SETQ pt (VLAX-INVOKE ent1 'IntersectWith ent2 ACEXTENDNONE))
(SETQ pts (CONS pt pts))
)
)
;;沿红线对点集排序
(SETQ pts (VL-SORT pts
'(LAMBDA (p1 p2)
(> (VLAX-CURVE-GETPARAMATPOINT ent1 p1)
(VLAX-CURVE-GETPARAMATPOINT ent1 p2)
)
)
)
)
;;画黄线并写入文件
(SETVAR "clayer" "图层1")
(COMMAND "_.PLINE")
(SETQ file (OPEN "c:/pts.txt" "w"))
(FOREACH item pts
(COMMAND item)
(WRITE-LINE (VL-PRINC-TO-STRING item) file)
)
(CLOSE file)
(COMMAND "")
(PRINC)
)
<p>大哥:</p><p>小弟在这里先谢谢你!</p><p>你的程序我调用过了,但加载tmp命令点选红线后,出现如下错误:</p><p>(选取一根红线:; 错误: no function definition: VLAX-ENAME->VLA-OBJECT)</p><p>我要的程序只是能提取"黄线"跟"纵向白色线"<交点坐标>就好了,最好生成的是TXT格式文本,我的图再上传一下,你下载后打开看看就明白我意思了,再一次谢谢你!</p> 对于出现错误:no function definition: VLAX-ENAME->VLA-OBJECT
如果你用的acad2000以后的版本,可在我的程序第一行前添加(vl-load-com),如果是r14就没有办法了
只选黄线,问题就简化为取黄线的节点坐标,不需要求交点,程序如下,可以运行在任何cad版本.
(DEFUN c:tmp (/ EL FILE PTS)
(SETQ EL (ENTGET (CAR (ENTSEL "\n选取一根黄线:"))))
(WHILE (AND EL (ASSOC 10 EL))
(SETQ PTS (CONS (ASSOC 10 EL) PTS)
EL(CDR (MEMBER (CAR PTS) EL))
)
)
;;写入文件
(SETQ file (OPEN "c:/pts.txt" "w"))
(FOREACH item (MAPCAR 'CDR (REVERSE pts))
;;下一行的","可改为其他的分隔符,比如" " "\t"
(WRITE-LINE
(STRCAT (RTOS (CAR item) 2 3) "," (RTOS (CADR item) 2 3))
file
)
)
(CLOSE file)
(PRINC)
)
<p>兄弟:</p><p>感谢你为我编的这程序,真的谢谢!</p><p>但程序还是用不了,我加载程序后,用TMP命令,然后选取黄色线条,但就没有了下文了,是否程序出现错乱,麻烦你看看,谢谢!</p> <p>在线等侯你回复，你ＱQ号系几多？我加你为好友．</p> 本帖最后由 作者 于 2007-3-1 17:50:19 编辑
忘记告诉你了,到硬盘的c驱下找pts.txt文件,里面就是所有的点
新程序增加了一句,会自动打开pts.txt,方便你操作.
(DEFUN c:tmp (/ EL FILE PTS)
(SETQ EL (ENTGET (CAR (ENTSEL "\n选取一根黄线:"))))
(WHILE (AND EL (ASSOC 10 EL))
(SETQ PTS (CONS (ASSOC 10 EL) PTS)
EL(CDR (MEMBER (CAR PTS) EL))
)
)
;;写入文件
(SETQ file (OPEN "c:/pts.txt" "w"))
(FOREACH item (MAPCAR 'CDR (REVERSE pts))
;;下一行的","可改为其他的分隔符,比如" " "\t"
(WRITE-LINE
(STRCAT (RTOS (CAR item) 2 3) "," (RTOS (CADR item) 2 3))
file
)
)
(CLOSE file)
(startapp "notepad" "c:/pts.txt")
(PRINC)
)
不好意思,很少聊天,以前的qq号被盗,就没有再申请了
<p>兄弟:</p><p>你好!</p><p>真谢谢你了,程序可用了,而且你改正后挺好用的,谢谢你!</p><p>以前我用LISP命令提取坐标,再经文本编辑小软件编著它,现在工作量快多了,真的谢谢你!</p><p>你的编程技术太高了,有什么事再请教你,还望留下你的大名.谢谢!</p>
页:
[1]