[求助]：请高手帮忙修改这个程序

PFD8667 · 发表于 2005-3-26 16:05:30

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

从网上下载的曲线等分相连程序很好用,如上图所示,因我不会编程,恳求高手能否将程序修改成如下图所示增加一斜线连接,我不懂编程见笑了,如不行就增加一个补上斜线的程序也可以的,先谢谢了,原程序如下:

;rul = 画线等分两条曲线 v2
;避开捕捉造成的错误画线.
;支持无关曲线起点终点. 根据点中曲线的位置画线.! 2004.1.7
;

(defun c:rul ( / msp el1 el2 e1 e2 n m d1 d2 sd1 sd2 key m)
(vl-load-com)
(vl-cmdf ".undo" "be")
(setq
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
el1 (entsel "\n第一条曲线:")
el2 (entsel "\n第二条曲线:")
e1 (vlax-ename->vla-object (car el1))
e2 (vlax-ename->vla-object (car el2))
n (getint "\n等分数:")
m n
d1 (vlax-curve-getDistAtparam e1 (vlax-curve-getendparam e1))
d2 (vlax-curve-getDistAtparam e2 (vlax-curve-getendparam e2))
sd1 (vlax-curve-getDistAtpoint e1 (vlax-curve-getClosestPointTo e1 (cadr el1)))
sd2 (vlax-curve-getDistAtpoint e2 (vlax-curve-getClosestPointTo e2 (cadr el2)))
key (if (or (and (< (/ sd1 d1) 0.5 ) (< (/ sd2 d2) 0.5))
(and (> (/ sd1 d1) 0.5 ) (> (/ sd2 d2) 0.5)))
T nil)
)
(repeat (1+ n)
(vla-addline msp (vlax-3d-point (vlax-curve-getPointAtDist e1 (* (/ d1 n) m)))
(vlax-3d-point (vlax-curve-getPointAtDist e2 (* (/ d2 n) (if key m (- n m))))))
(setq m (1- m))
)
(vl-cmdf ".undo" "e")
(princ)
)

david96007 · 发表于 2005-3-26 16:53:58

程序里的东西我基本上没有用过，但照猫画虎，将原作者的东西试着改了几次，应该能达到楼主的要求了！

(defun c:rul (
;;; / msp el1 el2 e1 e2 n m d1 d2 sd1 sd2 key m
)
(vl-load-com)
(vl-cmdf ".undo" "be")
(setq msp (vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
)
)
el1 (entsel "\n第一条曲线:")
el2 (entsel "\n第二条曲线:")
e1 (vlax-ename->vla-object
(car el1)
)
e2 (vlax-ename->vla-object
(car el2)
)
n (getint "\n等分数:")
m n
d1 (vlax-curve-getDistAtparam
e1
(vlax-curve-getendparam e1)
)
d2 (vlax-curve-getDistAtparam
e2
(vlax-curve-getendparam e2)
)
sd1 (vlax-curve-getDistAtpoint
e1
(vlax-curve-getClosestPointTo
e1
(cadr el1)
)
)
sd2 (vlax-curve-getDistAtpoint
e2
(vlax-curve-getClosestPointTo
e2
(cadr el2)
)
)
key (if (or (and (< (/ sd1 d1) 0.5)
(< (/ sd2 d2) 0.5)
)
(and (> (/ sd1 d1) 0.5)
(> (/ sd2 d2) 0.5)
)
)
T
nil
)
)
(repeat (1+ n)
(vla-addline
msp
(vlax-3d-point
(vlax-curve-getPointAtDist
e1
(* (/ d1 n) m)
)
)
(vlax-3d-point
(vlax-curve-getPointAtDist
e2
(* (/ d2 n)
(if key
m
(- n m)
)
)
)
)
)
(setq m (1- m))
)
(setq m n )
(repeat n
(vla-addline
msp
(vlax-3d-point
(vlax-curve-getPointAtDist
e1
(* (/ d1 n) m)
)
)
(vlax-3d-point
(vlax-curve-getPointAtDist
e2
(* (/ d2 n)
(if key
(1- m)
(1+ (- n m ))
)
)
)
)
)
(setq m (1- m))
)
(vl-cmdf ".undo" "e")
(princ)
)

(defun c:rul ( 
;;;              /        msp el1        el2 e1 e2 n m d1 d2 sd1        sd2 key        m 
              ) 
  (vl-load-com) 
  (vl-cmdf ".undo" "be") 
  (setq        msp (vla-get-modelspace 
              (vla-get-activedocument 
                (vlax-get-acad-object) 
              ) 
            ) 
        el1 (entsel "\n第一条曲线:") 
        el2 (entsel "\n第二条曲线:") 
        e1  (vlax-ename->vla-object 
              (car el1) 
            ) 
        e2  (vlax-ename->vla-object 
              (car el2) 
            ) 
        n   (getint "\n等分数:") 
        m   n 
        d1  (vlax-curve-getDistAtparam 
              e1 
              (vlax-curve-getendparam e1) 
            ) 
        d2  (vlax-curve-getDistAtparam 
              e2 
              (vlax-curve-getendparam e2) 
            ) 
        sd1 (vlax-curve-getDistAtpoint 
              e1 
              (vlax-curve-getClosestPointTo 
                e1 
                (cadr el1) 
              ) 
            ) 
        sd2 (vlax-curve-getDistAtpoint 
              e2 
              (vlax-curve-getClosestPointTo 
                e2 
                (cadr el2) 
              ) 
            ) 
        key (if        (or (and (< (/ sd1 d1) 0.5) 
                         (< (/ sd2 d2) 0.5) 
                    ) 
                    (and (> (/ sd1 d1) 0.5) 
                         (> (/ sd2 d2) 0.5) 
                    ) 
                ) 
              T 
              nil 
            ) 
  ) 
  (repeat (1+ n) 
    (vla-addline 
      msp 
      (vlax-3d-point 
        (vlax-curve-getPointAtDist 
          e1 
          (* (/ d1 n) m) 
        ) 
      ) 
      (vlax-3d-point 
        (vlax-curve-getPointAtDist 
          e2 
          (* (/ d2 n) 
             (if key 
               m 
               (- n m) 
             ) 
          ) 
        ) 
      ) 
    ) 
    (setq m (1- m)) 
  ) 
  (setq m n ) 
  (repeat n 
    (vla-addline 
      msp 
      (vlax-3d-point 
        (vlax-curve-getPointAtDist 
          e1 
          (* (/ d1 n) m) 
        ) 
      ) 
      (vlax-3d-point 
        (vlax-curve-getPointAtDist 
          e2 
          (* (/ d2 n) 
             (if key 
               (1- m) 
               (1+ (- n m )) 
             ) 
          ) 
        ) 
      ) 
    ) 
    (setq m (1- m)) 
  ) 
  (vl-cmdf ".undo" "e") 
  (princ) 
)

PFD8667 · 发表于 2005-3-26 18:48:19

太谢谢david96007 您了,我就是要这个效果程序,再次感谢您的热心!

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：请高手帮忙修改这个程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子