新手诚心求教，关于command的使用问题，有别的办法替代command操作实体吗？

caocaosasd

这是我根据大佬的指点写的，但是在command的使用上卡壳了，死活达不到效果。
我的目的是，把创建出来的直线ZX,ENT13,ENT24，以ZX的端点为起点，ENT13的端点为终点，进行平移操作，代码如下，

先是创建三条直线，然后根据http://bbs.mjtd.com/forum.php?mo ... mp;highlight=grread提供的grread使用方法，进行按键及时反馈的操作，可是它始终不执行……

;;;
(defun C:cxz1 (/ code loop ss L1 L2 KU PT1 PT2 PT3 PT4 ZX ENT13 ENT24 zP1 zP2 )
  (setq OLD_CMDECHO (getvar "CMDECHO"))
  (setq CL (getvar "clayer"))
  (setq plwidth (getvar "PLINEWID"))
  (setvar "CMDECHO" 0)
  (setvar "EDGEMODE" 1)
  (setvar "PLINEWID" 30)
  (command "-layer" "m" "fjgj" "C" "1" "" "")

  (setq L1 (getpoint))
  (setq L2 (getpoint L1))
  (setq KU (angle L1 L2))
  (setq PT1 (polar L1 (+ KU (* 0.5 pi)) 75))
  (setq PT2 (polar L1 (+ KU (* 1.5 pi)) 75))
  (setq PT3 (polar L2 (+ KU (* 0.5 pi)) 75))
  (setq PT4 (polar L2 (+ KU (* 1.5 pi)) 75))

  (command "line" "non" L1 "non" L2 "")
  (setq ZX (entlast))
  (command "line" "non" PT1 "non" PT3 "")
  (setq ENT13 (entlast))
  (command "line" "non" PT2 "non" PT4 "")
  (setq ENT24 (entlast))

  (setq  loop T )
  (prompt "\n 偏移(A)/退出(空格)]：")
  (while loop
    (setq code (grread T 8))
    (cond
      ((equal code '(2 97))
       (setq zP1 (cdr (assoc 10 (entget ZX))))
       (setq zP2 (cdr (assoc 10 (entget ENT13))))
       (setq dsa (distance zP1 zP2))
       ()
;;;       (command "line" zP1 zP2 "")  这个创建两点间直线的语句我注释掉了，如果不注释的话，这个是可执行的，真能达到效果，我安一次A就能造出一条直线，按一次造一次。说明我前面写的都没有问题，就后面那句command错了
      (command "move" ZX ENT13 ENT24  "" zP1 zP2)       ;;;;;这句话我真的不知道哪错了呀，我就想把这三条直线，以zP1为基点，一块儿平移到zP2
      )
      ((equal code '(2 32))
       (setq loop nil)
      )
    )
  )

  (setvar "clayer" CL)
  (setvar "CMDECHO" OLD_CMDECHO)
  (setvar "PLINEWID" plwidth)
  (princ)
)
;;;

ssyfeng

yshf

;ActiveX方式
(defun C:cxz2 (/ OLD_CMDECHO CL L1 L2 doc layers layer modelSpace KU PT1 PT2 PT3 PT4 objlist loop zp1 zp2)
  (setq OLD_CMDECHO (getvar "CMDECHO"))
  (setq CL (getvar "clayer"))
  (setvar "CMDECHO" 0)
  (setvar "EDGEMODE" 1)

  (if (setq L1 (getpoint "\起点:"))
      (If (setq L2 (getpoint L1 " 止点:"))
          (progn
              (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
              (setq layers (vlax-get-property doc "layers"))
              (setq modelSpace (vla-get-ModelSpace doc))
              ;新建图层
              (If (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list layers "fjgj")))
                  (progn
                      (setq layer (vla-Add layers "fjgj"))
                      (vlax-put-property layer "color" 6)
                  )
             )
             (setvar "clayer" "fjgj")

             ;计算出第2、3条直线的端点
             (setq KU (angle L1 L2))
             (setq PT1 (polar L1 (+ KU (* 0.5 pi)) 75))
             (setq PT2 (polar L1 (+ KU (* 1.5 pi)) 75))
             (setq PT3 (polar L2 (+ KU (* 0.5 pi)) 75))
             (setq PT4 (polar L2 (+ KU (* 1.5 pi)) 75))
             ;绘三段直线
             (setq objlist (mapcar '(lambda(p1 p2)
                                        (vla-AddLine modelSpace (vlax-3d-point p1) (vlax-3d-point p2))
                                    )
                                    (list L1 pt1 pt2)
                                    (list L2 pt3 pt4)
                            )
             )
             (setq pts (list (vlax-get-property (car  objlist) "StartPoint")
                             (vlax-get-property (car  objlist) "EndPoint")
                       )
             )
             ;偏移直线
             (setq loop T)
             (prompt "\n 往左偏移(A)/往右偏移(B)/删除或恢复中线(E)/<退出>：")
             (while (not (member (setq code (grread T 8)) '((2 32) (2 13))))
                 (cond ((equal code '(2 97) 0.1)
                           ;A键向左偏移
                           (setq zp1 (vlax-get-property (car  objlist) "StartPoint"))
                           (setq zp2 (vlax-get-property (cadr objlist) "StartPoint"))
                           (mapcar '(lambda(obj) (vla-Move Obj zp1 zp2)) objlist )
                           (setq pts (list (vlax-get-property (car objlist) "StartPoint")
                                           (vlax-get-property (car objlist) "EndPoint")
                                     )
                           )
                       )
                       ((equal code '(2 98) 0.1)
                           ;B键向右偏移
                           (setq zp1 (vlax-get-property (car  objlist) "StartPoint"))
                           (setq zp2 (vlax-get-property (last objlist) "StartPoint"))
                           (mapcar '(lambda(obj) (vla-Move Obj zp1 zp2)) objlist )
                           (setq pts (list (vlax-get-property (car objlist) "StartPoint")
                                           (vlax-get-property (car objlist) "EndPoint")
                                     )
                           )                          
                       )
                       ((equal code '(2 101) 0.1)
                           ;E键删除或恢复中线
                           (cond ((= (length objlist) 3)
                                     (vla-delete (car objlist))
                                     (setq objlist (vl-remove (car objlist) objlist))
                                 )
                                 ((= (length objlist) 2)
                                     (setq objlist (cons (vla-AddLine modelSpace (car pts) (cadr pts))
                                                         objlist
                                                   )
                                     )
                                 )
                           )
                       )
                  )
             )
             ;释放对象
             (mapcar '(lambda(obj)
                           (If (/= obj nil)
                               (progn (vlax-release-object obj)(setq obj nil))
                           )
                      )
                      (list layer layers modelSpace doc)
             )
          )
      )
  )

  (setvar "clayer" CL)
  (setvar "CMDECHO" OLD_CMDECHO)
  (princ)
)

lijiao

不用command,用纯lisp实现:

2. (defun C:cxz1 (/ ANG CL        CODE DSA ELIST ENT13 ENT24 KU L1 L2 LOOP OLD_CMDECHO PLWIDTH PT1 PT2 PT3 PT4 X ZP1 ZP2 ZX)
   
3.   (setq OLD_CMDECHO (getvar "CMDECHO"))
   
4.   (setq CL (getvar "clayer"))
   
5.   (setq plwidth (getvar "PLINEWID"))
   
6.   (setvar "CMDECHO" 0)
   
7.   (setvar "EDGEMODE" 1)
   
8.   (setvar "PLINEWID" 30)
   
9. ;;;  (command "-layer" "m" "fjgj" "C" "1" "" "")
   
10.   (if (not (tblsearch "layer" "fjgj"))
    
11.     (entmakex '((0 . "LAYER")
    
12.                 (100 . "AcDbSymbolTableRecord")
    
13.                 (100 . "AcDbLayerTableRecord")
    
14.                 (2 . "fjgj")
    
15.                 (70 . 0)
    
16.                 (62 . 1)
    
17.                )
    
18.     )
    
19.   )
    
20.   (setvar "clayer" "fjgj")
    
21. 
    
22. 
    
23.   (setq L1 (getpoint))
    
24.   (setq L2 (getpoint L1))
    
25.   (setq KU (angle L1 L2))
    
26.   (setq PT1 (polar L1 (+ KU (* 0.5 pi)) 75))
    
27.   (setq PT2 (polar L1 (+ KU (* 1.5 pi)) 75))
    
28.   (setq PT3 (polar L2 (+ KU (* 0.5 pi)) 75))
    
29.   (setq PT4 (polar L2 (+ KU (* 1.5 pi)) 75))
    
30. 
    
31. ;;;  (command "line" "non" L1 "non" L2 "")
    
32. ;;;  (setq ZX (entlast))
    
33. ;;;  (command "line" "non" PT1 "non" PT3 "")
    
34. ;;;  (setq ENT13 (entlast))
    
35. ;;;  (command "line" "non" PT2 "non" PT4 "")
    
36. ;;;  (setq ENT24 (entlast))
    
37.   (setq zx (entmakex (list '(0 . "LINE") (cons 10 l1) (cons 11 l2))))
    
38.   (setq ENT13 (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3))))
    
39.   (setq ENT24 (entmakex (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4))))
    
40. 
    
41. 
    
42. 
    
43.   (setq loop T)
    
44.   (prompt "\n 偏移(A)/<退出>：")
    
45.   (while (not (member (setq code (grread T 8)) '((2 32) (2 13))))
    
46.     (if        (equal code '(2 97) 0.1)
    
47.       (progn
    
48.         (setq zP1 (cdr (assoc 10 (entget ZX))))
    
49.         (setq zP2 (cdr (assoc 10 (entget ENT13))))
    
50.         (setq dsa (distance zP1 zP2))
    
51.         (setq ang (angle zP1 zP2))
    
52. ;;;       (command "line" zP1 zP2 "")  这个创建两点间直线的语句我注释掉了，如果不注释的话，这个是可执行的，真能达到效果，我安一次A就能造出一条直线，按一次造一次。说明我前面写的都没有问题，就后面那句command错了
    
53. ;;;       (command "move" ZX ENT13 ENT24 "" zP1 zP2)
    
54. ;;;;;这句话我真的不知道哪错了呀，我就想把这三条直线，以zP1为基点，一块儿平移到zP2
    
55.         (mapcar        '(lambda (x)
    
56.                    (setq elist (entget x))
    
57.                    (setq elist (subst (cons 10 (polar (cdr (assoc 10 elist)) ang dsa))
    
58.                                       (assoc 10 elist)
    
59.                                       elist
    
60.                                )
    
61.                    )
    
62.                    (setq elist (subst (cons 11 (polar (cdr (assoc 11 elist)) ang dsa))
    
63.                                       (assoc 11 elist)
    
64.                                       elist
    
65.                                )
    
66.                    )
    
67.                    (entmod elist)
    
68.                  )
    
69.                 (list ZX ENT13 ENT24)
    
70.         )
    
71.       )
    
72.     )
    
73.   )
    
74. 
    
75.   (setvar "clayer" CL)
    
76.   (setvar "CMDECHO" OLD_CMDECHO)
    
77.   (setvar "PLINEWID" plwidth)
    
78.   (princ)
    
79. )

(defun C:cxz1 (/ ANG CL        CODE DSA ELIST ENT13 ENT24 KU L1 L2 LOOP OLD_CMDECHO PLWIDTH PT1 PT2 PT3 PT4 X ZP1 ZP2 ZX)<br />   (setq OLD_CMDECHO (getvar "CMDECHO"))<br />   (setq CL (getvar "clayer"))<br />   (setq plwidth (getvar "PLINEWID"))<br />   (setvar "CMDECHO" 0)<br />   (setvar "EDGEMODE" 1)<br />   (setvar "PLINEWID" 30)<br /> ;;;  (command "-layer" "m" "fjgj" "C" "1" "" "")<br />   (if (not (tblsearch "layer" "fjgj"))<br />     (entmakex '((0 . "LAYER")<br />                 (100 . "AcDbSymbolTableRecord")<br />                 (100 . "AcDbLayerTableRecord")<br />                 (2 . "fjgj")<br />                 (70 . 0)<br />                 (62 . 1)<br />                )<br />     )<br />   )<br />   (setvar "clayer" "fjgj")<br /> <br /> <br />   (setq L1 (getpoint))<br />   (setq L2 (getpoint L1))<br />   (setq KU (angle L1 L2))<br />   (setq PT1 (polar L1 (+ KU (* 0.5 pi)) 75))<br />   (setq PT2 (polar L1 (+ KU (* 1.5 pi)) 75))<br />   (setq PT3 (polar L2 (+ KU (* 0.5 pi)) 75))<br />   (setq PT4 (polar L2 (+ KU (* 1.5 pi)) 75))<br /> <br /> ;;;  (command "line" "non" L1 "non" L2 "")<br /> ;;;  (setq ZX (entlast))<br /> ;;;  (command "line" "non" PT1 "non" PT3 "")<br /> ;;;  (setq ENT13 (entlast))<br /> ;;;  (command "line" "non" PT2 "non" PT4 "")<br /> ;;;  (setq ENT24 (entlast))<br />   (setq zx (entmakex (list '(0 . "LINE") (cons 10 l1) (cons 11 l2))))<br />   (setq ENT13 (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3))))<br />   (setq ENT24 (entmakex (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4))))<br /> <br /> <br /> <br />   (setq loop T)<br />   (prompt "\n 偏移(A)/<退出>：")<br />   (while (not (member (setq code (grread T 8)) '((2 32) (2 13))))<br />     (if        (equal code '(2 97) 0.1)<br />       (progn<br />         (setq zP1 (cdr (assoc 10 (entget ZX))))<br />         (setq zP2 (cdr (assoc 10 (entget ENT13))))<br />         (setq dsa (distance zP1 zP2))<br />         (setq ang (angle zP1 zP2))<br /> ;;;       (command "line" zP1 zP2 "")  这个创建两点间直线的语句我注释掉了，如果不注释的话，这个是可执行的，真能达到效果，我安一次A就能造出一条直线，按一次造一次。说明我前面写的都没有问题，就后面那句command错了<br /> ;;;       (command "move" ZX ENT13 ENT24 "" zP1 zP2)<br /> ;;;;;这句话我真的不知道哪错了呀，我就想把这三条直线，以zP1为基点，一块儿平移到zP2<br />         (mapcar        '(lambda (x)<br />                    (setq elist (entget x))<br />                    (setq elist (subst (cons 10 (polar (cdr (assoc 10 elist)) ang dsa))<br />                                       (assoc 10 elist)<br />                                       elist<br />                                )<br />                    )<br />                    (setq elist (subst (cons 11 (polar (cdr (assoc 11 elist)) ang dsa))<br />                                       (assoc 11 elist)<br />                                       elist<br />                                )<br />                    )<br />                    (entmod elist)<br />                  )<br />                 (list ZX ENT13 ENT24)<br />         )<br />       )<br />     )<br />   )<br /> <br />   (setvar "clayer" CL)<br />   (setvar "CMDECHO" OLD_CMDECHO)<br />   (setvar "PLINEWID" plwidth)<br />   (princ)<br /> )

ssyfeng

测试代码注释和不注释都可以运行。

caocaosasd

ssyfeng 发表于 2021-6-16 13:43
测试代码注释和不注释都可以运行。

啥意思呀，没看懂
command画zp1，zp2的连线那个可以运行；但是command move那个不能运行…

aihuyujian

(setq ss nil ss (ssadd))
(ssadd ZX ss)
(ssadd ENT13 ss)
(ssadd ENT24 ss)
(command "move" ss  "" "none" zP1 "none" zP2)

ssyfeng

是可以运行，但不知道是不是你要的结果

paulpipi

学习一下，谢谢楼上

start4444

截个图说明比较好，估计是没关捕捉

caocaosasd

非常非常感谢各位大佬的指点！接下来我一一拜读一下~
尤其是学习一下如果不使用command命令会怎样