本帖最后由 123456abc 于 2014-3-1 17:47 编辑

下面是一组从网上获取的拉伸程序，执行后提示错误： 错误: 无法获取 ObjectID: nil，请高手帮忙改进一下，多谢！！

(defun c:ofss (/ E G O P1 P2 V1 V2 V3);
*************************************************************************************************
*        by ElpanovEvgeniy 26.02.2010
*        ----------------
*        27.02.2010 8:30
*        fix bug for acad 2004 (vlax-curve-getFirstDeriv e (vlax-curve-getEndParam e))
*        ----------------
*        27.02.2010 8:55
*        fix bug for first arc segment
*************************************************************************************************
(setq e  (entsel)
       p1 (cadr e)
       e  (car e)
       p1 (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointTo e p1)))
       o  (vlax-ename->vla-object e));_ setq
(if (= 1 (cdr (assoc 70 (entget e))))
  (cond ((zerop p1)
         (setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))
                        (vlax-curve-getFirstDeriv e (1- (vlax-curve-getEndParam e)))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e 0.5))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
         ) ;_  setq
        )
        ((= p1 (1- (vlax-curve-getEndParam e)))
         (setq p2 0
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
         ) ;_  setq
        )
        ((setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
         ) ;_  setq
        )
  ) ;_  cond
  (cond ((zerop p1)
         (setq p2 (1+ p1)
               v2 (list (vlax-curve-getPointAtParam e 0) (vlax-curve-getFirstDeriv e 0.5))
               v1 (list (car v2) (list (cadadr v2) (- (caadr v2)) 0.))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
         ) ;_  setq
        )
        ((= p1 (1- (vlax-curve-getEndParam e)))
         (setq p2 (vlax-curve-getEndParam e)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (list (cadadr v2) (- (caadr v2)) 0.))
         ) ;_  setq
        )
        ((setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
         ) ;_  setq
        )
  ) ;_  cond
) ;_  if
(while (= (car (setq g (grread nil 5 0))) 5)
  (vla-put-coordinate
   o
   p1
   (vlax-make-variant
    (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
                         (reverse (cdr (reverse (inters (car v1)
                                                        (mapcar '+ (car v1) (cadr v1))
                                                        (cadr g)
                                                        (mapcar '+ (cadr g) (cadr v2))
                                                        nil
                                                ) ;_  inters
                                       ) ;_  reverse
                                  ) ;_  cdr
                         ) ;_  reverse
    ) ;_  vlax-safearray-fill
   ) ;_  vlax-make-variant
  ) ;_  vla-put-coordinate
  (vla-put-coordinate
   o
   p2
   (vlax-make-variant
    (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
                         (reverse (cdr (reverse (inters (car v3)
                                                        (mapcar '+ (car v3) (cadr v3))
                                                        (cadr g)
                                                        (mapcar '+ (cadr g) (cadr v2))
                                                        nil
                                                ) ;_  inters
                                       ) ;_  reverse
                                  ) ;_  cdr
                         ) ;_  reverse
    ) ;_  vlax-safearray-fill
   ) ;_  vlax-make-variant
  ) ;_  vla-put-coordinate
) ;_  while
(princ)
)



网友答:
Andyhon 发表于 2014-3-1 13:12
应是注解部份的干扰...

大师您好 能加个捕捉不

网友答:
edata 发表于 2014-3-1 17:31
要选择不低于三点的多段线

能不能实现有捕捉？

网友答:
很强大，只是能加上捕捉就更好了

网友答: 应是注解部份的干扰...


网友答: 还是不能用，一样的错误啊

网友答: 要选择不低于三点的多段线
  1. ;|
  2. *************************************************************************************************
  3. *        by ElpanovEvgeniy 26.02.2010
  4. *        ----------------
  5. *        27.02.2010 8:30
  6. *        fix bug for acad 2004 (vlax-curve-getFirstDeriv e (vlax-curve-getEndParam e))
  7. *        ----------------
  8. *        27.02.2010 8:55
  9. *        fix bug for first arc segment
  10. *************************************************************************************************
  11. |;

  13. (defun c:ofss (/ E G O P1 P2 V1 V2 V3)        ;
  14.   (vl-load-com)
  15.   (prompt "\n选择不低于三点的多段线:")
  16.   (setq        e (entsel))
  17.   (if (and e (= (cdr(assoc 0 (entget (car e)))) "LWPOLYLINE"))
  18.            (progn
  19.          (setq
  20.         p1 (cadr e)
  21.         e  (car e)
  22.         p1 (fix        (vlax-curve-getParamAtPoint
  23.                   e
  24.                   (vlax-curve-getClosestPointTo e p1)
  25.                 )
  26.            )
  27.         o  (vlax-ename->vla-object e)
  28.   ) ;_ setq
  29.   (if (= 1 (cdr (assoc 70 (entget e))))
  30.     (cond
  31.       ((zerop p1)
  32.        (setq p2        (1+ p1)
  33.              v1        (list
  34.                   (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))
  35.                   (vlax-curve-getFirstDeriv
  36.                     e
  37.                     (1- (vlax-curve-getEndParam e))
  38.                   )
  39.                 ) ;_  list
  40.              v2        (list (vlax-curve-getPointAtParam e p1)
  41.                       (vlax-curve-getFirstDeriv e 0.5)
  42.                 )
  43.              v3        (list (vlax-curve-getPointAtParam e p2)
  44.                       (vlax-curve-getFirstDeriv e 1.5)
  45.                 )
  46.        ) ;_  setq
  47.       )
  48.       ((= p1 (1- (vlax-curve-getEndParam e)))
  49.        (setq p2        0
  50.              v1        (list (vlax-curve-getPointAtParam e (1- p1))
  51.                       (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  52.                 ) ;_  list
  53.              v2        (list (vlax-curve-getPointAtParam e p1)
  54.                       (vlax-curve-getFirstDeriv e (+ p1 0.5))
  55.                 )
  56.              v3        (list (vlax-curve-getPointAtParam e p2)
  57.                       (vlax-curve-getFirstDeriv e (+ p2 0.5))
  58.                 )
  59.        ) ;_  setq
  60.       )
  61.       ((setq p2        (1+ p1)
  62.              v1        (list (vlax-curve-getPointAtParam e (1- p1))
  63.                       (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  64.                 ) ;_  list
  65.              v2        (list (vlax-curve-getPointAtParam e p1)
  66.                       (vlax-curve-getFirstDeriv e (+ p1 0.5))
  67.                 )
  68.              v3        (list (vlax-curve-getPointAtParam e p2)
  69.                       (vlax-curve-getFirstDeriv e (+ p2 0.5))
  70.                 )
  71.        ) ;_  setq
  72.       )
  73.     ) ;_  cond
  74.     (cond
  75.       ((zerop p1)
  76.        (setq p2        (1+ p1)
  77.              v2        (list (vlax-curve-getPointAtParam e 0)
  78.                       (vlax-curve-getFirstDeriv e 0.5)
  79.                 )
  80.              v1        (list (car v2) (list (cadadr v2) (- (caadr v2)) 0.))
  81.              v3        (list (vlax-curve-getPointAtParam e p2)
  82.                       (vlax-curve-getFirstDeriv e 1.5)
  83.                 )
  84.        ) ;_  setq
  85.       )
  86.       ((= p1 (1- (vlax-curve-getEndParam e)))
  87.        (setq p2        (vlax-curve-getEndParam e)
  88.              v1        (list (vlax-curve-getPointAtParam e (1- p1))
  89.                       (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  90.                 ) ;_  list
  91.              v2        (list (vlax-curve-getPointAtParam e p1)
  92.                       (vlax-curve-getFirstDeriv e (+ p1 0.5))
  93.                 )
  94.              v3        (list (vlax-curve-getPointAtParam e p2)
  95.                       (list (cadadr v2) (- (caadr v2)) 0.)
  96.                 )
  97.        ) ;_  setq
  98.       )
  99.       ((setq p2        (1+ p1)
  100.              v1        (list (vlax-curve-getPointAtParam e (1- p1))
  101.                       (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  102.                 ) ;_  list
  103.              v3        (list (vlax-curve-getPointAtParam e p2)
  104.                       (vlax-curve-getFirstDeriv e (+ p2 0.5))
  105.                 )
  106.              v2        (list (vlax-curve-getPointAtParam e p1)
  107.                       (vlax-curve-getFirstDeriv e (+ p1 0.5))
  108.                 )
  109.        ) ;_  setq
  110.       )
  111.     ) ;_  cond
  112.   ) ;_  if
  113.   (while (= (car (setq g (grread nil 5 0))) 5)
  114.     (vla-put-coordinate
  115.       o
  116.       p1
  117.       (vlax-make-variant
  118.         (vlax-safearray-fill
  119.           (vlax-make-safearray 5 '(0 . 1))
  120.           (reverse
  121.             (cdr
  122.               (reverse
  123.                 (inters
  124.                   (car v1)
  125.                   (mapcar '+ (car v1) (cadr v1))
  126.                   (cadr g)
  127.                   (mapcar '+ (cadr g) (cadr v2))
  128.                   nil
  129.                 ) ;_  inters
  130.               ) ;_  reverse
  131.             ) ;_  cdr
  132.           ) ;_  reverse
  133.         ) ;_  vlax-safearray-fill
  134.       ) ;_  vlax-make-variant
  135.     ) ;_  vla-put-coordinate
  136.     (vla-put-coordinate
  137.       o
  138.       p2
  139.       (vlax-make-variant
  140.         (vlax-safearray-fill
  141.           (vlax-make-safearray 5 '(0 . 1))
  142.           (reverse
  143.             (cdr
  144.               (reverse
  145.                 (inters
  146.                   (car v3)
  147.                   (mapcar '+ (car v3) (cadr v3))
  148.                   (cadr g)
  149.                   (mapcar '+ (cadr g) (cadr v2))
  150.                   nil
  151.                 ) ;_  inters
  152.               ) ;_  reverse
  153.             ) ;_  cdr
  154.           ) ;_  reverse
  155.         ) ;_  vlax-safearray-fill
  156.       ) ;_  vlax-make-variant
  157.     ) ;_  vla-put-coordinate
  158.   ) ;_  while
  159.     )
  160.   )
  161.   (princ)
  162. )


网友答: 恩，确实是要选三点，多谢

网友答: 怎么才能让这个程序有捕捉

网友答: 这个不是太好用，不能按照距离拉伸

网友答: 很强大，只是能加上捕捉就更好了
  • 上一篇：批量重命名块，防止块被冲
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025