[源码] 多线mline绘制vla方法

admin

1. (defun $make-mline$ (pts lst)
2.                                         ;($make-mline$(list (getpoint)(getpoint))(list(cons "比例" "随便")))
3.   (if (and (= (rem (length (car pts)) 3) 0)
4.            (>= (length pts) 2)
5.       )
6.     (PROGN (setq obj (vl-catch-all-apply
7.                        'vla-addmline
8.                        (list
9.                          (vlax-get-property
10.                            (vla-get-activedocument (vlax-get-acad-object))
11.                            (if (= 1 (getvar 'CVPORT))
12.                              'Paperspace
13.                              'Modelspace
14.                            )
15.                          )
16.                          (vl-catch-all-apply
17.                            'vlax-make-variant
18.                            (list
19.                              (vl-catch-all-apply
20.                                'vlax-safearray-fill
21.                                (list
22.                                  (vl-catch-all-apply
23.                                    'vlax-make-safearray
24.                                    (list
25.                                      vlax-vbDouble
26.                                      (cons 1 (* 3 (length pts)))
27.                                    )
28.                                  )
29.                                  (apply 'append pts)
30.                                )
31.                              )
32.                            )
33.                          )
34.                        )
35.                      )
36.            )
37.            (vl-catch-all-apply
38.              'vla-put-MLineScale
39.              (list
40.                obj
41.                (cdr (assoc "比例" lst))
42.              )
43.            )
44.     )
45.   )
46.   (SETQ ENT (VL-CATCH-ALL-APPLY 'VLAX-ENAME->VLA-OBJECT (LIST OBJ)))
47.   (IF (VL-CATCH-ALL-ERROR-P ENT)
48.     (SETQ ENT NIL)
49.   )
50.   ent
51. )

复制代码