论坛 › AutoLisp › [源码] 多线mline绘制vla方法

admin 发表于 2024-4-17 07:59:50

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

(defun $make-mline$ (pts lst)
                                        ;($make-mline$(list (getpoint)(getpoint))(list(cons "比例" "随便")))
(if (and (= (rem (length (car pts)) 3) 0)
         (>= (length pts) 2)
      )
    (PROGN (setq obj (vl-catch-all-apply
                     'vla-addmline
                     (list
                         (vlax-get-property
                           (vla-get-activedocument (vlax-get-acad-object))
                           (if (= 1 (getvar 'CVPORT))
                           'Paperspace
                           'Modelspace
                           )
                         )
                         (vl-catch-all-apply
                           'vlax-make-variant
                           (list
                           (vl-catch-all-apply
                               'vlax-safearray-fill
                               (list
                                 (vl-catch-all-apply
                                 'vlax-make-safearray
                                 (list
                                     vlax-vbDouble
                                     (cons 1 (* 3 (length pts)))
                                 )
                                 )
                                 (apply 'append pts)
                               )
                           )
                           )
                         )
                     )
                     )
         )
         (vl-catch-all-apply
             'vla-put-MLineScale
             (list
               obj
               (cdr (assoc "比例" lst))
             )
         )
    )
)
(SETQ ENT (VL-CATCH-ALL-APPLY 'VLAX-ENAME->VLA-OBJECT (LIST OBJ)))
(IF (VL-CATCH-ALL-ERROR-P ENT)
    (SETQ ENT NIL)
)
ent
)

查看完整版本: [源码] 多线mline绘制vla方法