[LISP]求学 这样的程序该怎样编写

zhongguola

我在实际工作中常常会遇到提取图形坐标值并生成表格插入到图形中的难道。比如说按顺序提取公路桩的坐标值.该公路的路路边是由多条pl线连接,由pe命令合并为一条.该公路的边缘有许多公路桩与公路边相交.(注意:该公路桩的点位并不一定是在pl连接线的每个连接点上)

恳请高手编写一个能够按顺序提取桩位坐标值,并能将坐标值已队列的形式插入到图形的程序.(如图)

先谢谢大家了!

ljpnb

不知道是不是这样的，还不够完善，只出了一个大概

zhongguola

是这个意思

但是有一点我要请您注意了：该公路的路路边是由多条pl线连接,由pe命令合并为一条.该公路的边缘有许多公路桩与公路边相交.(注意:该公路桩的点位并不一定是在pl连接线的每个连接点上)

也就是说当我们点取pl时提取的坐标往往是多条pl线端点的坐标而不是我所要求的与公路桩相交的坐标值。

该图形是这样完成的：公路是有许多条直线画的，然后用pe命令合并成一条pl线

最后把公路桩做成块，嵌套在这条pl线上。

我所需要的就是嵌套在pl线上的公路桩与pl线交点的坐标。

谢谢！

ljpnb

其实我刚才演示的那个程序并不没有求pl连接线的连接点，而是直接求一个个块的插入点。

zhongguola

我想请求高手直接点击pl线就可以顺序批量求出块插入点的坐标值，最中实现图中的上述功能  

行吗？？？

ljpnb

下面这段程序不太完善，对求值顺序有些刚好相反

3. (defun c:test ()
4.   (setvar "cmdecho" 0)
5.   (setq ent (car (entsel "\n选择一条多义线")))
6.   (if (= (setq str (getstring "\n输入起始的桩号<J1>:")) "")
7.     (setq str "J1")
8.   )
9.   (command "zoom" "all")
10.   (command "zoom" "0.5x")
11.   (setq obj (vlax-ename->vla-object ent))
12.   (vla-offset obj -1)
13.   (setq ent1 (entlast))
14.   (vla-offset obj 1)
15.   (setq ent2 (entlast))
16.   (setq lst1 (point-lst ent1)
17. lst2 (reverse (point-lst ent2))
18. lst  (append lst1 lst2)
19. k    0
20.   )
21.   (command "select" "cp")
22.   (while (setq point (nth (setq K (1+ k)) lst))
23.     (command point)
24.   )
25.   (command "" "")
26.   (setq
27.     ss (ssget "p"
28.        '((0 . "INSERT"))
29.        )
30.   )
31.   (entdel ent1)
32.   (entdel ent2)
33.   (setq j    -1
34. lst3 '()
35.   )
36.   (while (setq ent4 (ssname ss (setq j (1+ j))))
37.     (setq lst3 (append (list (cdr (assoc 10 (entget ent4)))) lst3))
38.   )
39.   (setq
40.     lst3 (vl-sort
41.     lst3
42.     '(lambda (a b)
43.        (> (vlax-curve-getParamAtPoint obj a)
44.    (vlax-curve-getParamAtPoint obj b)
45.        )
46.      )
47.   )
48.   )
49.   (setq k -1)
50.   (setq text-point (getpoint "\n输入一个起点:"))
51.   (setq num  (atoi (substr str 2))
52. loop T
53.   )
54.   (setvar "TEXTSTYLE" "WMF-宋体0")
55.   (while (setq point (nth (setq k (1+ k)) lst3))
56.     (setq x (car point)
57.    y (cadr point)
58.     )
59.     (setq tex (strcat "J"
60.         (rtos (+ num k))
61.         "       "
62.         (rtos x)
63.         "   "
64.         (rtos y)
65.        )
66.     )
67.     (if loop
68.       (progn
69. (command "text" text-point 5.5 "" tex)
70. (setq loop nil)
71.       )
72.       (command "text" "" tex)
73.     )
74.   )
75. (setvar "cmdecho" 1)
76.   (princ)
77. )
78. ;;;子函数
79. (defun point-lst (ent00 / obj00 lst00 lst01 i)
80.   (setq obj00 (vlax-ename->vla-object ent00))
81.   (setq lst00 (vlax-get obj00 'Coordinates))
82.   (setq i 0
83. lst01 '()
84.   )
85.   (repeat (/ (length lst00) 2)
86.     (setq
87.       lst01 (cons (list (nth i lst00) (nth (1+ i) lst00)) lst01)
88.     )
89.     (setq i (+ i 2))
90.   )
91.   lst01
92. )

(defun c:test ()   (setvar "cmdecho" 0)   (setq ent (car (entsel "\n选择一条多义线")))   (if (= (setq str (getstring "\n输入起始的桩号<J1>:")) "")     (setq str "J1")   )   (command "zoom" "all")   (command "zoom" "0.5x")   (setq obj (vlax-ename->vla-object ent))   (vla-offset obj -1)   (setq ent1 (entlast))   (vla-offset obj 1)   (setq ent2 (entlast))   (setq lst1 (point-lst ent1) lst2 (reverse (point-lst ent2)) lst  (append lst1 lst2) k    0   )   (command "select" "cp")   (while (setq point (nth (setq K (1+ k)) lst))     (command point)   )   (command "" "")   (setq     ss (ssget "p"        '((0 . "INSERT"))        )   )   (entdel ent1)   (entdel ent2)   (setq j    -1 lst3 '()   )   (while (setq ent4 (ssname ss (setq j (1+ j))))     (setq lst3 (append (list (cdr (assoc 10 (entget ent4)))) lst3))   )   (setq     lst3 (vl-sort     lst3     '(lambda (a b)        (> (vlax-curve-getParamAtPoint obj a)    (vlax-curve-getParamAtPoint obj b)        )      )   )   )   (setq k -1)   (setq text-point (getpoint "\n输入一个起点:"))   (setq num  (atoi (substr str 2)) loop T   )   (setvar "TEXTSTYLE" "WMF-宋体0")   (while (setq point (nth (setq k (1+ k)) lst3))     (setq x (car point)    y (cadr point)     )     (setq tex (strcat "J"         (rtos (+ num k))         "       "         (rtos x)         "   "         (rtos y)        )     )     (if loop       (progn (command "text" text-point 5.5 "" tex) (setq loop nil)       )       (command "text" "" tex)     )   ) (setvar "cmdecho" 1)   (princ) ) ;;;子函数 (defun point-lst (ent00 / obj00 lst00 lst01 i)   (setq obj00 (vlax-ename->vla-object ent00))   (setq lst00 (vlax-get obj00 'Coordinates))   (setq i 0 lst01 '()   )   (repeat (/ (length lst00) 2)     (setq       lst01 (cons (list (nth i lst00) (nth (1+ i) lst00)) lst01)     )     (setq i (+ i 2))   )   lst01 )

zhongguola

首先谢谢您的程序。

但是该程序在运行时还有些问题：

命令：test

选择一条多义线

输入起始的桩号<J1>:J1

;错误：no function difintion :Vlax-Ename->Vla-object

 

zhongguola

问题已经解决了！！！

再次感谢您了！！！！！

zhongguola

请问ljpnb兄：您的程序为啥在这个图形中就不行了呢？

ljpnb

那你需要求什么，没有那些路桩当然不行了？