MOVE动态移动，将一个命令掰开玩儿

dcl1214

1. ;示例1
   
2. (setq ent (car (entsel)))
   
3. (setq pt (getpoint))
   
4. (vl-cmdf "move" ent "")
   
5. (while (= 1 (logand 1 (getvar 'cmdactive)))
   
6.   (vl-cmdf pt "\\")
   
7.   (setq pts (append pts (list (getvar 'lastpoint))))
   
8. )
   
9. (alert "移动完成")
   
10. ;示例二
    
11.                                         ;copy  move  addtext  三合一（你想咋玩都行）
    
12. (and (setq c (car (entsel "请选择一个圆")))
    
13.      (setq obj (vlax-ename->vla-object c))
    
14.      (setq pt-C        (vlax-safearray->list
    
15.                   (vlax-variant-value (vla-get-center OBJ))
    
16.                 )
    
17.      )
    
18. )
    
19. (if (and obj
    
20.          pt-C
    
21.          (SETQ PT (GETPOINT "请点击鼠标左键开始绘制直线"))
    
22.     )
    
23.   (progn (setq i 1)
    
24.          (vl-cmdf "_.pline" "non" pt)
    
25.          (setq e-L (entlast))
    
26.          (while        (= 1 (logand 1 (getvar 'cmdactive)))
    
27.            (vl-cmdf "\\")
    
28.            (if (= 1 (logand 1 (getvar 'cmdactive)))
    
29.              (progn
    
30.                (setq p (getvar 'lastpoint))
    
31.                (setq obj-new (vla-copy obj))
    
32.                (vla-move obj-new
    
33.                          (vlax-3d-point pt-C)
    
34.                          (vlax-3d-point p)
    
35.                )
    
36.                (vla-AddText
    
37.                  (vla-get-modelSpace
    
38.                    (vla-get-ActiveDocument (vlax-get-acad-object))
    
39.                  )
    
40.                  (itoa i)
    
41.                  (vlax-3d-Point p)
    
42.                  6
    
43.                )
    
44.                (setq i (1+ i))
    
45.              )
    
46.            )
    
47.          )
    
48.   )
    
49. )
    

;示例1<br /> (setq ent (car (entsel)))<br /> (setq pt (getpoint))<br /> (vl-cmdf "move" ent "")<br /> (while (= 1 (logand 1 (getvar 'cmdactive)))<br />   (vl-cmdf pt "\\")<br />   (setq pts (append pts (list (getvar 'lastpoint))))<br /> )<br /> (alert "移动完成")<br /> ;示例二<br />                                         ;copy  move  addtext  三合一（你想咋玩都行）<br /> (and (setq c (car (entsel "请选择一个圆")))<br />      (setq obj (vlax-ename->vla-object c))<br />      (setq pt-C        (vlax-safearray->list<br />                   (vlax-variant-value (vla-get-center OBJ))<br />                 )<br />      )<br /> )<br /> (if (and obj<br />          pt-C<br />          (SETQ PT (GETPOINT "请点击鼠标左键开始绘制直线"))<br />     )<br />   (progn (setq i 1)<br />          (vl-cmdf "_.pline" "non" pt)<br />          (setq e-L (entlast))<br />          (while        (= 1 (logand 1 (getvar 'cmdactive)))<br />            (vl-cmdf "\\")<br />            (if (= 1 (logand 1 (getvar 'cmdactive)))<br />              (progn<br />                (setq p (getvar 'lastpoint))<br />                (setq obj-new (vla-copy obj))<br />                (vla-move obj-new<br />                          (vlax-3d-point pt-C)<br />                          (vlax-3d-point p)<br />                )<br />                (vla-AddText<br />                  (vla-get-modelSpace<br />                    (vla-get-ActiveDocument (vlax-get-acad-object))<br />                  )<br />                  (itoa i)<br />                  (vlax-3d-Point p)<br />                  6<br />                )<br />                (setq i (1+ i))<br />              )<br />            )<br />          )<br />   )<br /> )<br />

kozmosovia

(vl-cmdf "move" (Car(entsel)) "" (getpoint) pause)就行，没必要折腾

dcl1214

kozmosovia 发表于 2023-10-16 10:29
(vl-cmdf "move" (Car(entsel)) "" (getpoint) pause)就行，没必要折腾

你没看懂
请看下面代码
(if (SETQ PT(GETPOINT))
  (progn (vl-cmdf "_.pline" "non" pt)
         (setq e-L (entlast))
         (while        (= 1 (logand 1 (getvar 'cmdactive)))
           (vl-cmdf "\\")
         )
  )
)

dcl1214

while里面可以加各种其他代码，这是一种写法，可以让一个命令拆开，并在中间加各种逻辑代码

panliang9

很有意思！