请大家帮忙：在多义线上随便一位置添加一点

flyingfish

我想在多义线上随便一点就能添加一点。用CAD中的命令PEDIT太费事，
有没有好一点的方法，直接用鼠标一点就能在所点的位置添加一点。谢谢各位
请帮忙

lockmyeye

旧程序，期待改进。
(GET_POINTS ENT1)定义为获取ent1的点，返回((所有坐标列表)(最大坐标)(最小坐标))

2. ;;;7/23/03
   
3. ;;;复合线顶点编辑工具
   
4. (defun C:PEDIT_EV (ANGLE1 ANGLE2 ANGLE3 DATA DATA_NEW DIST1 ENT1 MODIFY_MODE NUM1 POINT1 POINTS POINT_NUM1)
   
5.   ;;选取一条多段线
   
6.   (while (progn        (while (not (setq ENT1 (car (entsel "\n\t选择要编辑的多段线:")))))
   
7.                 (not (wcmatch (cdr (assoc '0 (entget ENT1))) "*POLYLINE"))
   
8.          )
   
9.     (princ "\n\t选择的不是多段线。")
   
10.   )
    
11.   (setq MODIFY_MODE "Add")
    
12.   (while (/= MODIFY_MODE "eXit")
    
13.     (princ (strcat "\n\tAdd增加点/Del删除点/Move移动点/eXit退出<"
    
14.                    (cond ((= "Move" MODIFY_MODE) "Move移动点")
    
15.                          ((= "Add" MODIFY_MODE) "Add增加点")
    
16.                          ((= "Del" MODIFY_MODE) "Del删除点")
    
17.                    )
    
18.                    ">:"
    
19.            )
    
20.     )
    
21.     (setq DATA (grread NIL))
    
22.     (cond ((= 2 (car DATA))
    
23.            (cond ((= 120 (cadr DATA)) (setq MODIFY_MODE "eXit"))
    
24.                  ((or (= 65 (cadr DATA)) (= 97 (cadr DATA))) (setq MODIFY_MODE "Add"))
    
25.                  ((or (= 68 (cadr DATA)) (= 100 (cadr DATA))) (setq MODIFY_MODE "Del"))
    
26.                  ((or (= 77 (cadr DATA)) (= 109 (cadr DATA))) (setq MODIFY_MODE "Move"))
    
27.            )
    
28.           )
    
29.           ((= 3 (car DATA))
    
30.            ;;与线上点最小距离
    
31.            (setq POINT1 (mapcar '* (cadr DATA) (list 1 1)))
    
32.            (setq POINTS (car (GET_POINTS ENT1)))
    
33.            (setq DIST1 (distance POINT1 (car POINTS))) ;与线上点最小距离
    
34.            (setq POINT_NUM1 0)                          ;与线上点最小距离的点序号
    
35.            (setq NUM1 0)
    
36.            (foreach TEMP POINTS
    
37.              (if (> DIST1 (distance TEMP POINT1))
    
38.                (progn (setq DIST1 (distance TEMP POINT1)) (setq POINT_NUM1 NUM1))
    
39.              )
    
40.              (setq NUM1 (1+ NUM1))
    
41.            )
    
42.            ;;进行处理
    
43.            (setq DATA (entget ENT1))
    
44.            (setq DATA_NEW (list))
    
45.            (setq NUM1 0)
    
46.            (foreach TEMP DATA
    
47.              (if (and (= 10 (car TEMP)) (= NUM1 POINT_NUM1))
    
48.                (cond ;;增加点
    
49.                      ((= "Add" MODIFY_MODE)
    
50.                       ;;angle1        前角
    
51.                       ;;angle2        后角
    
52.                       (if (= 0 POINT_NUM1)
    
53.                         (setq ANGLE1 (angle (nth (+ POINT_NUM1 1) POINTS) (nth POINT_NUM1 POINTS))) ;延长角的角度
    
54.                         (setq ANGLE1 (angle (nth POINT_NUM1 POINTS) (nth (- POINT_NUM1 1) POINTS)))
    
55.                       )
    
56.                       (if (= (- (length POINTS) 1) POINT_NUM1)
    
57.                         (setq ANGLE2 (angle (nth (- POINT_NUM1 1) POINTS) (nth POINT_NUM1 POINTS))) ;延长角的角度
    
58.                         (setq ANGLE2 (angle (nth POINT_NUM1 POINTS) (nth (+ POINT_NUM1 1) POINTS)))
    
59.                       )
    
60.                       (setq ANGLE3 (angle (nth POINT_NUM1 POINTS) POINT1)) ;
    
61.                       (setq ANGLE1 (- ANGLE1 ANGLE3))
    
62.                       (setq ANGLE2 (- ANGLE3 ANGLE2))
    
63.                       (if (< ANGLE1 0)
    
64.                         (setq ANGLE1 (+ ANGLE1 pi pi))
    
65.                       )
    
66.                       (if (< ANGLE2 0)
    
67.                         (setq ANGLE2 (+ ANGLE2 pi pi))
    
68.                       )
    
69.                       (if (or (and (< ANGLE1 ANGLE2) (< (+ ANGLE1 ANGLE2) (+ pi pi))) ;内角时小于360度且前角小于后角
    
70.                               (and (> ANGLE1 ANGLE2) (> (+ ANGLE1 ANGLE2) (+ pi pi))) ;外角时大于360度且前角大于后角
    
71.                           )
    
72.                         ;;条件为真时加在最近点前面
    
73.                         (setq DATA_NEW (append DATA_NEW
    
74.                                                (list (append (list 10) POINT1))
    
75.                                                (list (assoc '40 DATA) (assoc '41 DATA) (assoc '42 DATA))
    
76.                                                (list TEMP)
    
77.                                        )
    
78.                         )
    
79.                         ;;条件为假时加在最近点后面
    
80.                         (setq DATA_NEW (append DATA_NEW
    
81.                                                (list TEMP)
    
82.                                                (list (assoc '40 DATA) (assoc '41 DATA) (assoc '42 DATA))
    
83.                                                (list (append (list 10) POINT1))
    
84.                                        )
    
85.                         )
    
86.                       )
    
87.                      )
    
88.                      ;;移动点
    
89.                      ((= "Move" MODIFY_MODE) (setq DATA_NEW (append DATA_NEW (list (append (list 10) POINT1)))))
    
90.                      ;;删除点
    
91.                      ;;就不用处理
    
92.                )
    
93.                (setq DATA_NEW (append DATA_NEW (list TEMP)))
    
94.              )
    
95.              (if (= 10 (car TEMP))
    
96.                (setq NUM1 (1+ NUM1))
    
97.              )
    
98.            )
    
99.            (if (not (entmod DATA_NEW))
    
100.              (*ERROR* "不能更新实体数据!")
     
101.            )
     
102.           )
     
103.           ((= 12 (car DATA)) (setq MODIFY_MODE "eXit"))
     
104.     )
     
105.   )
     
106.   (princ)
     
107. )

;;;7/23/03<br /> ;;;复合线顶点编辑工具<br /> (defun C:PEDIT_EV (ANGLE1 ANGLE2 ANGLE3 DATA DATA_NEW DIST1 ENT1 MODIFY_MODE NUM1 POINT1 POINTS POINT_NUM1)<br />   ;;选取一条多段线<br />   (while (progn        (while (not (setq ENT1 (car (entsel "\n\t选择要编辑的多段线:")))))<br />                 (not (wcmatch (cdr (assoc '0 (entget ENT1))) "*POLYLINE"))<br />          )<br />     (princ "\n\t选择的不是多段线。")<br />   )<br />   (setq MODIFY_MODE "Add")<br />   (while (/= MODIFY_MODE "eXit")<br />     (princ (strcat "\n\tAdd增加点/Del删除点/Move移动点/eXit退出<"<br />                    (cond ((= "Move" MODIFY_MODE) "Move移动点")<br />                          ((= "Add" MODIFY_MODE) "Add增加点")<br />                          ((= "Del" MODIFY_MODE) "Del删除点")<br />                    )<br />                    ">:"<br />            )<br />     )<br />     (setq DATA (grread NIL))<br />     (cond ((= 2 (car DATA))<br />            (cond ((= 120 (cadr DATA)) (setq MODIFY_MODE "eXit"))<br />                  ((or (= 65 (cadr DATA)) (= 97 (cadr DATA))) (setq MODIFY_MODE "Add"))<br />                  ((or (= 68 (cadr DATA)) (= 100 (cadr DATA))) (setq MODIFY_MODE "Del"))<br />                  ((or (= 77 (cadr DATA)) (= 109 (cadr DATA))) (setq MODIFY_MODE "Move"))<br />            )<br />           )<br />           ((= 3 (car DATA))<br />            ;;与线上点最小距离<br />            (setq POINT1 (mapcar '* (cadr DATA) (list 1 1)))<br />            (setq POINTS (car (GET_POINTS ENT1)))<br />            (setq DIST1 (distance POINT1 (car POINTS))) ;与线上点最小距离<br />            (setq POINT_NUM1 0)                          ;与线上点最小距离的点序号<br />            (setq NUM1 0)<br />            (foreach TEMP POINTS<br />              (if (> DIST1 (distance TEMP POINT1))<br />                (progn (setq DIST1 (distance TEMP POINT1)) (setq POINT_NUM1 NUM1))<br />              )<br />              (setq NUM1 (1+ NUM1))<br />            )<br />            ;;进行处理<br />            (setq DATA (entget ENT1))<br />            (setq DATA_NEW (list))<br />            (setq NUM1 0)<br />            (foreach TEMP DATA<br />              (if (and (= 10 (car TEMP)) (= NUM1 POINT_NUM1))<br />                (cond ;;增加点<br />                      ((= "Add" MODIFY_MODE)<br />                       ;;angle1        前角<br />                       ;;angle2        后角<br />                       (if (= 0 POINT_NUM1)<br />                         (setq ANGLE1 (angle (nth (+ POINT_NUM1 1) POINTS) (nth POINT_NUM1 POINTS))) ;延长角的角度<br />                         (setq ANGLE1 (angle (nth POINT_NUM1 POINTS) (nth (- POINT_NUM1 1) POINTS)))<br />                       )<br />                       (if (= (- (length POINTS) 1) POINT_NUM1)<br />                         (setq ANGLE2 (angle (nth (- POINT_NUM1 1) POINTS) (nth POINT_NUM1 POINTS))) ;延长角的角度<br />                         (setq ANGLE2 (angle (nth POINT_NUM1 POINTS) (nth (+ POINT_NUM1 1) POINTS)))<br />                       )<br />                       (setq ANGLE3 (angle (nth POINT_NUM1 POINTS) POINT1)) ;<br />                       (setq ANGLE1 (- ANGLE1 ANGLE3))<br />                       (setq ANGLE2 (- ANGLE3 ANGLE2))<br />                       (if (< ANGLE1 0)<br />                         (setq ANGLE1 (+ ANGLE1 pi pi))<br />                       )<br />                       (if (< ANGLE2 0)<br />                         (setq ANGLE2 (+ ANGLE2 pi pi))<br />                       )<br />                       (if (or (and (< ANGLE1 ANGLE2) (< (+ ANGLE1 ANGLE2) (+ pi pi))) ;内角时小于360度且前角小于后角<br />                               (and (> ANGLE1 ANGLE2) (> (+ ANGLE1 ANGLE2) (+ pi pi))) ;外角时大于360度且前角大于后角<br />                           )<br />                         ;;条件为真时加在最近点前面<br />                         (setq DATA_NEW (append DATA_NEW<br />                                                (list (append (list 10) POINT1))<br />                                                (list (assoc '40 DATA) (assoc '41 DATA) (assoc '42 DATA))<br />                                                (list TEMP)<br />                                        )<br />                         )<br />                         ;;条件为假时加在最近点后面<br />                         (setq DATA_NEW (append DATA_NEW<br />                                                (list TEMP)<br />                                                (list (assoc '40 DATA) (assoc '41 DATA) (assoc '42 DATA))<br />                                                (list (append (list 10) POINT1))<br />                                        )<br />                         )<br />                       )<br />                      )<br />                      ;;移动点<br />                      ((= "Move" MODIFY_MODE) (setq DATA_NEW (append DATA_NEW (list (append (list 10) POINT1)))))<br />                      ;;删除点<br />                      ;;就不用处理<br />                )<br />                (setq DATA_NEW (append DATA_NEW (list TEMP)))<br />              )<br />              (if (= 10 (car TEMP))<br />                (setq NUM1 (1+ NUM1))<br />              )<br />            )<br />            (if (not (entmod DATA_NEW))<br />              (*ERROR* "不能更新实体数据!")<br />            )<br />           )<br />           ((= 12 (car DATA)) (setq MODIFY_MODE "eXit"))<br />     )<br />   )<br />   (princ)<br /> )

luoyaya

2. (defun c:jd (/ ent p obj n pp pn newv)
   
3.   (if (setq ent (entsel "\n点取pline:"))
   
4.     (progn
   
5.       (setq p (cadr ent))
   
6.       (setq obj (vlax-ename->vla-object (car ent)))
   
7.       (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))
   
8.       (setq n (fix (vlax-curve-getparamatpoint obj pp)))
   
9.       (setq pn p)
   
10.       (while (setq pn (getpoint pn "\n输入要加点的位置: "))
    
11.           (command "undo" "be")
    
12.           (setq pn (trans pn 1 (car ent)))
    
13.           (setq pn (list (car pn) (cadr pn)))
    
14.           (setq        newv (vlax-safearray-fill
    
15.                        (vlax-make-safearray vlax-vbDouble '(0 . 1))
    
16.                        pn
    
17.                      )
    
18.           )
    
19.           (vla-addvertex obj (1+ n) newv)
    
20.           (command "undo" "e")
    
21.        
    
22.       )
    
23. 
    
24.     )
    
25.   )
    
26.   (princ)
    
27. )

(defun c:jd (/ ent p obj n pp pn newv)<br />   (if (setq ent (entsel "\n点取pline:"))<br />     (progn<br />       (setq p (cadr ent))<br />       (setq obj (vlax-ename->vla-object (car ent)))<br />       (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))<br />       (setq n (fix (vlax-curve-getparamatpoint obj pp)))<br />       (setq pn p)<br />       (while (setq pn (getpoint pn "\n输入要加点的位置: "))<br />           (command "undo" "be")<br />           (setq pn (trans pn 1 (car ent)))<br />           (setq pn (list (car pn) (cadr pn)))<br />           (setq        newv (vlax-safearray-fill<br />                        (vlax-make-safearray vlax-vbDouble '(0 . 1))<br />                        pn<br />                      )<br />           )<br />           (vla-addvertex obj (1+ n) newv)<br />           (command "undo" "e")<br />         <br />       )<br /> <br />     )<br />   )<br />   (princ)<br /> )

简单的功能单的PLINE加点:)

shicai

楼上的程序码好象在哪见过, 如果不是你写的最好注明...

flyingfish

谢谢。我试了一下luoyaya 的程序，但出现如下错误，我想问一下，是否需要设置CAD环境中的什么才能用这些VLAX函数
no function definition: VLAX-ENAME->VLA-OBJECT

shicai

加一行: (vl-load-com)

flyingfish

我觉得这个是不是又添加了一条多义线啊，我想加完点后仍然是一条很正常的多义线，可以吗

meflying

先加载(vl-load-com)

龙龙仔

shicai发表于2003-12-8 12:19:00楼上的程序码好象在哪见过, 如果不是你写的最好注明...

好像是出自
;; By Richard L
;; Parker Hannifin Ltd (NZ).

;; 給多義線添加頂點
(defun ADDVERTEX (ENAME P)
  (setq        OBJ  (vlax-ename->vla-object ENAME)
        PP   (vlax-curve-getclosestpointto OBJ (trans P 1 0))
        N    (fix (vlax-curve-getparamatpoint OBJ PP))
        PN   (getpoint "\nPick a Point: ")
        PN   (list (car PN) (cadr PN))
        NEWV (vlax-safearray-fill
               (vlax-make-safearray vlax-vbdouble '(0 . 1))
               PN
             )
  )
  (vla-addvertex OBJ (1+ N) NEWV)
)

luoyaya

龙龙仔发表于2003-12-8 15:52:00以下是引用shicai在2003-12-8 12:19:32的发言：
楼上的程序码好象在哪见过, 如果不是你写的最好注明...

好像是出自
;; By Richard L
;; Parker Hannifin Ltd (NZ).

;; 給多義線添加頂點
(defun ADDVERTEX (ENAME P)
   (s...
[/quote]


不好意思,今天才看到,是的,是用了这个函数改了一下:),当时忘了写上~~~