求大佬完善一下这个偏移

＿Levin

求大佬帮忙完善一下，弄了一晚上，实在不会了




(defun c:KK (/ *error* en os p0)               
        (setq oldlayer (getvar "clayer"));_记录当前图层
        (if (not (tblsearch "layer" "图层AA"))
                (command "layer" "m" "图层AA" "c" 2 "" "lt" "DASHDOT" "" "")  ;建立图层
        )
        (setvar "clayer" "图层AA")
       
        (defun *error* (msg)
                (princ mag)
                (setvar "cmdecho" 1)
                (setvar "osmode" os)               
                (princ)
        )
        (setq os (getvar "osmode"))
        (mapcar 'setvar '("cmdecho" "osmode") '(0 0))
        (setq SS 50)
       
        (while (and (setq en (car (entsel))) (setq p0 (getpoint "\n偏移方向:")))
                (if (= SS 0)
                        (command "copy" en "" p0 p0)
                        (command "offset" SS en p0 "")
                )
               
                (VLA-PUT-LAYER (VLAX-ENAME->VLA-OBJECT (ENTLAST))"图层AA")       
                (setq ent (ssget "X" (list (cons 8 "图层A")(cons 410 (getvar 'ctab)))))
                (command "change" ent "" "p" "c" "bylayer" "")                                       
        )
        (setvar "clayer" OldLayer)       
        (setvar "cmdecho" 1)
        (setvar "osmode" os)
        (princ)
)

liuhe

2. (defun c:KK (/ *error* en os p0)
   
3.   (setq oldlayer (getvar "clayer")) ;_记录当前图层
   
4.   (if (not (tblsearch "layer" "图层AA"))
   
5.     (command "layer" "m" "图层AA" "c" 2 "" "lt" "DASHDOT" "" "")
   
6.                                         ;建立图层
   
7.   )
   
8.   (setvar "clayer" "图层AA")
   
9. 
   
10.   (defun *error* (msg)
    
11.     (princ mag)
    
12.     (setvar "cmdecho" 1)
    
13.     (setvar "osmode" os)
    
14.     (princ)
    
15.   )
    
16.   (setq os (getvar "osmode"))
    
17.   (mapcar 'setvar '("cmdecho" "osmode") '(0 0))
    
18.   (setq        SS   50
    
19.         SS1  (SSADD)
    
20.         LST  NIL
    
21.         LST1 NIL
    
22.         I    0
    
23.   )
    
24.   (SETQ SS1 (SSGET))
    
25.   (setq p0 (getpoint "\n偏移方向:"))
    
26.   (REPEAT (SSLENGTH SS1)
    
27.     (SETQ E (SSNAME SS1 I))
    
28.     (if        (= SS 0)
    
29.       (command "copy" en "" p0 p0)
    
30.       (command "offset" SS e p0 "")
    
31.     )
    
32.     (SETQ E1  (ENTLAST)
    
33.           LST (CONS E1 LST)
    
34.           I   (1+ I)
    
35.     )
    
36.     (VLA-PUT-LAYER (VLAX-ENAME->VLA-OBJECT (ENTLAST)) "图层AA")
    
37.   )
    
38.   (IF (> (LENGTH LST) 1)
    
39.     (PROGN
    
40.       (SETQ II 0
    
41.             J (1+ II)
    
42.       )
    
43.       (REPEAT (1- (LENGTH LST))
    
44.         (REPEAT        (- (LENGTH LST) J )
    
45.           (SETQ        OBJ1 (vlax-ename->vla-object (NTH II LST))
    
46.                 OBJ2 (vlax-ename->vla-object (NTH J LST))
    
47.           )
    
48. 
    
49.           (setq        ipts (vlax-variant-value
    
50.                        (vla-intersectwith
    
51.                          obj1
    
52.                          obj2
    
53.                          acExtendNone
    
54.                        )
    
55.                      )
    
56.           )
    
57.           (if (> (vlax-safearray-get-u-bound ipts 1) 0)
    
58.             (progn
    
59.               (setq ipts (vlax-safearray->list ipts)
    
60.                                         ;将vla交点变体转化成表的形式
    
61.                     lst1 '()
    
62.               )
    
63.               (if (> (length ipts) 3)        ;分离多个交点
    
64.                 (repeat        (/ (length ipts) 3)
    
65.                   (setq        lst1
    
66.                              (cons (list (car ipts) (cadr ipts) (caddr ipts))
    
67.                                    lst1
    
68.                              )
    
69.                         ipts (cdddr ipts)
    
70.                   )
    
71.                 )
    
72.                 (SETQ LST1 (LIST ipts))
    
73.               )
    
74. 
    
75. 
    
76.               (FOREACH X (LIST (NTH II LST) (NTH J LST))
    
77.                 (IF
    
78.                   (> (DISTANCE (vlax-curve-getEndPoint X) (CAR LST1))
    
79.                      (DISTANCE (vlax-curve-getStartPoint X) (CAR LST1))
    
80.                   )
    
81.                    (VLA-PUT-StartPoint
    
82.                      (vlax-ename->vla-object X)
    
83.                      (vlax-3D-point (CAR LST1))
    
84.                    )
    
85.                    (VLA-PUT-EndPoint
    
86.                      (vlax-ename->vla-object X)
    
87.                      (vlax-3D-point (CAR LST1))
    
88.                    )
    
89.                 )
    
90.               )
    
91.             )
    
92.           )
    
93.           (SETQ J (1+ J))
    
94.         )
    
95.         (SETQ II (1+ II))
    
96.       )
    
97.     )
    
98.   )
    
99.   (setq
    
100.     ent        (ssget "X" (list (cons 8 "图层A") (cons 410 (getvar 'ctab))))
     
101.   )
     
102.   (command "change" ent "" "p" "c" "bylayer" "")
     
103.   (setvar "clayer" OldLayer)
     
104.   (setvar "cmdecho" 1)
     
105.   (setvar "osmode" os)
     
106.   (princ)
     
107. )

(defun c:KK (/ *error* en os p0)<br />   (setq oldlayer (getvar "clayer")) ;_记录当前图层<br />   (if (not (tblsearch "layer" "图层AA"))<br />     (command "layer" "m" "图层AA" "c" 2 "" "lt" "DASHDOT" "" "")<br />                                         ;建立图层<br />   )<br />   (setvar "clayer" "图层AA")<br /> <br />   (defun *error* (msg)<br />     (princ mag)<br />     (setvar "cmdecho" 1)<br />     (setvar "osmode" os)<br />     (princ)<br />   )<br />   (setq os (getvar "osmode"))<br />   (mapcar 'setvar '("cmdecho" "osmode") '(0 0))<br />   (setq        SS   50<br />         SS1  (SSADD)<br />         LST  NIL<br />         LST1 NIL<br />         I    0<br />   )<br />   (SETQ SS1 (SSGET))<br />   (setq p0 (getpoint "\n偏移方向:"))<br />   (REPEAT (SSLENGTH SS1)<br />     (SETQ E (SSNAME SS1 I))<br />     (if        (= SS 0)<br />       (command "copy" en "" p0 p0)<br />       (command "offset" SS e p0 "")<br />     )<br />     (SETQ E1  (ENTLAST)<br />           LST (CONS E1 LST)<br />           I   (1+ I)<br />     )<br />     (VLA-PUT-LAYER (VLAX-ENAME->VLA-OBJECT (ENTLAST)) "图层AA")<br />   )<br />   (IF (> (LENGTH LST) 1)<br />     (PROGN<br />       (SETQ II 0<br />             J (1+ II)<br />       )<br />       (REPEAT (1- (LENGTH LST))<br />         (REPEAT        (- (LENGTH LST) J )<br />           (SETQ        OBJ1 (vlax-ename->vla-object (NTH II LST))<br />                 OBJ2 (vlax-ename->vla-object (NTH J LST))<br />           )<br /> <br />           (setq        ipts (vlax-variant-value<br />                        (vla-intersectwith<br />                          obj1<br />                          obj2<br />                          acExtendNone<br />                        )<br />                      )<br />           )<br />           (if (> (vlax-safearray-get-u-bound ipts 1) 0)<br />             (progn<br />               (setq ipts (vlax-safearray->list ipts)<br />                                         ;将vla交点变体转化成表的形式<br />                     lst1 '()<br />               )<br />               (if (> (length ipts) 3)        ;分离多个交点<br />                 (repeat        (/ (length ipts) 3)<br />                   (setq        lst1<br />                              (cons (list (car ipts) (cadr ipts) (caddr ipts))<br />                                    lst1<br />                              )<br />                         ipts (cdddr ipts)<br />                   )<br />                 )<br />                 (SETQ LST1 (LIST ipts))<br />               )<br /> <br /> <br />               (FOREACH X (LIST (NTH II LST) (NTH J LST))<br />                 (IF<br />                   (> (DISTANCE (vlax-curve-getEndPoint X) (CAR LST1))<br />                      (DISTANCE (vlax-curve-getStartPoint X) (CAR LST1))<br />                   )<br />                    (VLA-PUT-StartPoint<br />                      (vlax-ename->vla-object X)<br />                      (vlax-3D-point (CAR LST1))<br />                    )<br />                    (VLA-PUT-EndPoint<br />                      (vlax-ename->vla-object X)<br />                      (vlax-3D-point (CAR LST1))<br />                    )<br />                 )<br />               )<br />             )<br />           )<br />           (SETQ J (1+ J))<br />         )<br />         (SETQ II (1+ II))<br />       )<br />     )<br />   )<br />   (setq<br />     ent        (ssget "X" (list (cons 8 "图层A") (cons 410 (getvar 'ctab))))<br />   )<br />   (command "change" ent "" "p" "c" "bylayer" "")<br />   (setvar "clayer" OldLayer)<br />   (setvar "cmdecho" 1)<br />   (setvar "osmode" os)<br />   (princ)<br /> )

下文没句号。

来学习来学习来学习

＿Levin

liuhe 发表于 2023-5-25 23:07

向您学习~