[求助]请帮忙编这个程序

wengsg 发表于 2004-1-30 17:27:00

在原有图的两条样条曲线上，先选择①，后选择②，最终形成③形状的“示坡线”，如有哪位大虾帮忙，我将感激不尽！！

meflying 发表于 2004-1-30 18:33:00

;函数:GetInterPOint
;功能:返回两个对象的所有交点
;参数:ent1、ent2均为ename对象
(vl-load-com)
(defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
 ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
 (repeat (/ (+ 1
 (- (vlax-safearray-get-u-bound intpoints 1)
 (vlax-safearray-get-l-bound intpoints 1)
 )
 )
 3
 )
 (setq points (append points (list (list
 (vlax-safearray-get-element intpoints i)
 (vlax-safearray-get-element intpoints (+ i 1))
 (vlax-safearray-get-element intpoints (+ i 2))
 )))
 )
 (setq i (+ 3 i))
 )
)
points
)(defun err(msg)
(princ msg)
(setvar "osmode" os)
(setvar "cmdecho" cmd)
(setq *error* errtmp)
(command "_.undo" "e")
(princ)
)(defun c:test( / ent1 ent2 entv1 entv2 pts param11 param12 param21 param22 param1 param2 i n2 pt1 pt2)
(setq os (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(command "_.undo" "be")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq errtmp *error*)
(setq *error* err)
(setq ent1 (car (entsel "\nSelect the first line...")))
(setq ent2 (car (entsel "\nSelect the second line...")))
(if (not n)
 (setq n (getint "\n输入密度:"))
 (progn (setq n2 (getint (strcat "\n输入密度<" (itoa n) ">:")))
 (if n2
(setq n n2)
 )
 )
)
(setq pts (GetInterpoint ent1 ent2))
(setq entv1 (vlax-ename->vla-object ent1))
(setq entv2 (vlax-ename->vla-object ent2))
(setq param11 (vlax-curve-getParamAtPoint entv1 (car pts)))
(setq param12 (vlax-curve-getParamAtPoint entv1 (cadr pts)))
(setq param21 (vlax-curve-getParamAtPoint entv2 (car pts)))
(setq param22 (vlax-curve-getParamAtPoint entv2 (cadr pts)))
(setq i 1)
(setq param1 (/ (- param12 param11) n))
(setq param2 (/ (- param22 param21) n))
(repeat (1- n)
 (setq pt1 (vlax-curve-getPointAtParam ent1 (+ param11 (* param1 i))))
 (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param21 (* param2 i))))
 (if (= (* (/ i 2) 2) i)
 (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)
 (/ (+ (cadr pt1) (cadr pt2)) 2.0)
 (/ (+ (last pt1) (last pt2)) 2.0)
 ))
 )
 (command "_.line" pt1 pt2 "")
 (setq i (1+ i))
)
(setvar "osmode" os)
(setvar "cmdecho" cmd)
(setq *error* errtmp)
(command "_.undo" "e")
(princ)
)

wengsg 发表于 2004-1-30 18:59:00

非常感谢，我真没想到这么快就给了回复。我真心祝愿“明经CAD社区”越办越红火，同时我要把这个好网站介绍给我的亲朋好友。

wengsg 发表于 2004-1-30 19:24:00

程序很好用，如果能定出短线与长线之间的间距能固定一个参数（如：2.0mm），然后程序自动进行画线，而无需输入密度。

__|__|__ 就是“|”之间的间距固定一个参数

meflying 发表于 2004-1-30 20:15:00

(if (not n) (setq n (getint "\n输入密度:")) (progn (setq n2 (getint (strcat "\n输入密度<" (itoa n) ">:"))) (if n2 (setq n n2) ) ) ) 将以上部分去掉，改为：

(setq n 10)

其中，10可以改为适当数字，你可以多改几次以调整。

这种方法是根据两点间的程度进行等分，间距（其实也不能算间距，因为不平行），根据图形大小不同，间距会不同

wengsg 发表于 2004-1-30 21:30:00

短线能否垂直于①，这样看起来比较美观。

meflying 发表于 2004-1-31 12:49:00

垂直于1，但在1上不均匀。可以做到在1上均匀，但垂直于2，如果垂直于1又1上均匀，将比较复杂。看是否可以就这样。。。;函数:GetInterPOint
;功能:返回两个对象的所有交点
;参数:ent1、ent2均为ename对象
(vl-load-com)
(defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
            ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
   (repeat (/ (+ 1
                        (- (vlax-safearray-get-u-bound intpoints 1)
                              (vlax-safearray-get-l-bound intpoints 1)
                        )
                  )
                  3
            )
      (setq points (append points (list (list
            (vlax-safearray-get-element intpoints i)
            (vlax-safearray-get-element intpoints (+ i 1))
            (vlax-safearray-get-element intpoints (+ i 2))
      )))
      )
      (setq i (+ 3 i))
   )
)
points
)(defun err(msg)
(princ msg)
(setvar "osmode" os)
(setvar "cmdecho" cmd)
(setq *error* errtmp)
(command "_.undo" "e")
(princ)
)(defun c:test( / ent1 ent2 pts param11 param12 param1 i pt1 pt2)
(setq os (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(command "_.undo" "be")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq errtmp *error*)
(setq *error* err)
(setq ent1 (car (entsel "\nSelect the first line...")))
(setq ent2 (car (entsel "\nSelect the second line...")))
(setq n 10)
(setq pts (GetInterpoint ent1 ent2))
(setq param11 (vlax-curve-getParamAtPoint ent2 (car pts)))
(setq param12 (vlax-curve-getParamAtPoint ent2 (cadr pts)))
(setq i 1)
(setq param1 (/ (- param12 param11) n))
(repeat (1- n)
   (setq pt2 (vlax-curve-getPointAtParam ent2 (+ param11 (* param1 i))))
   (setq pt1 (vlax-curve-getClosestPointTo ent1 pt2))
   (if (= (* (/ i 2) 2) i)
      (setq pt2 (list (/ (+ (car pt1) (car pt2)) 2.0)
            (/ (+ (cadr pt1) (cadr pt2)) 2.0)
            (/ (+ (last pt1) (last pt2)) 2.0)
            ))
   )
   (command "_.line" pt1 pt2 "")
   (setq i (1+ i))
)
(setvar "osmode" os)
(setvar "cmdecho" cmd)
(setq *error* errtmp)
(command "_.undo" "e")
(princ)
)

无痕发表于 2004-2-1 02:06:00

<A href="http://www.xdcad.com/forum/showthread.php?postid=752371#post752371" target="_blank" >http://www.xdcad.com/forum/showthread.php?postid=752371#post752371 </A>

yfy2003 发表于 2004-2-1 02:10:00

楼上的怎么看不见啊?

yfy2003 发表于 2004-2-1 02:15:00

这是测绘用的吧!

自然斜坡的！

最好能按第二条线等分、法线！

页: [1] 2

明经CAD社区's Archiver

[求助]请帮忙编这个程序