两曲线之间插入等距曲线插件

dhcad · 发表于 2019-1-17 11:51:47

求在两曲线之间插入等距曲线插件，谢谢

newer · 发表于 2019-1-17 12:07:04

你这是用什么插件做的？
把制作的结果的DWG，传下来下吧。

dhcad · 发表于 2019-1-19 09:27:45

newer 发表于 2019-1-17 12:07
你这是用什么插件做的？
把制作的结果的DWG，传下来下吧。

这是在明经论坛上看到的动画示意图，就是不知道用的什么插件

王鹏_pBZlo · 发表于 2019-3-20 19:14:33

十等分吗？
来自: 微社区

王鹏_pBZlo · 发表于 2019-3-25 09:22:08

本帖最后由王鹏_pBZlo 于 2019-3-25 09:24 编辑

10等分,插入了9根线(defun c:djx( / ent1 ent2 num p1list p2list p3list i cp p1 bfb)
(setq ent1 (car (entsel "\n[选择第1线条]:")))
(setq ent2 (car (entsel"\n[选择第2线条]:")))
(setq num 100)
(if (ssget "x" (list (cons 0 "POINT"))) (command "erase" (ssget "x" (list (cons 0 "POINT"))) ""))
(command "divide" ent1 num)
(setq ent1 (ssget "x" (list (cons 0 "POINT"))))
(setq p1list nil i 0)
(while (setq cp (ssname ent1 i))
(setq p1list (append p1list (list (cdr (assoc 10 (entget cp))))))
(setq i (1+ i))
)
(command "erase" ent1 "")
(command "divide" ent2 num)
(setq ent2 (ssget "x" (list (cons 0 "POINT"))))
(setq p2list nil i 0)
(while (setq cp (ssname ent2 i))
(setq p2list (append p2list (list (cdr (assoc 10 (entget cp))))))
(setq i (1+ i))
)
(command "erase" ent2 "")
(if (> (distance (nth 0 p1list) (nth 0 p2list)) (distance (nth 0 p1list) (nth (- num 2) p2list)))
      (setq p2list (reverse p2list))
)
(setq bfb 0.1)
(command "undo" "be")
      (repeat 9
(setq i 0 p3list nil)
(while (and (setq cp (nth i p1list)) (setq cp1 (nth i p2list)))
(setq p3 (list (+ (car cp) (* (- (car cp1) (car cp)) bfb)) (+ (cadr cp) (* (- (cadr cp1) (cadr cp)) bfb))))
(setq p3list (append p3list (list p3)) i (1+ i))
)

(setq temposm (getvar "osmode"))
(setvar "osmode" 0)
(setq i 2 p1 (nth 0 p3list) cp (nth 1 p3list))
(command "pline" (trans p1 0 1) (trans cp 0 1) "")
(setq ent1 (entlast) p1 cp)
(while (setq cp (nth i p3list))
(command "line" (trans p1 0 1) (trans cp 0 1) "")
(command "pedit" ent1 "J" (entlast) "" "")
(setq p1 cp i (1+ i))
)
(command "change" (entlast) "" "P" "C" "3" "")
(setq bfb (+ bfb 0.1))
      )
(setvar "osmode" temposm)
(command "undo" "e")
(princ)
)

xdzcp · 发表于 2019-6-1 16:04:45

王鹏_pBZlo 发表于 2019-3-25 09:22
10等分,插入了9根线(defun c:djx( / ent1 ent2 num p1list p2list p3list i cp p1 bfb)
(setq ent1 (car ...

能否改成可以输入自由段数。就完美了。

xdzcp · 发表于 2019-6-5 14:58:01

王鹏_pBZlo 发表于 2019-3-25 09:22
10等分,插入了9根线(defun c:djx( / ent1 ent2 num p1list p2list p3list i cp p1 bfb)
(setq ent1 (car ...

大师说错了是希望能否改成输入自定义根数。

azyg125 · 发表于 2019-6-5 20:57:38

有源码了，改下就行
来自: 微社区

王鹏_pBZlo · 发表于 2019-6-7 09:16:22

xdzcp 发表于 2019-6-5 14:58
大师说错了是希望能否改成输入自定义根数。

程序中的变量bfb初始值为0.1，即与第一条曲线距离与2曲线距离的比值为0.1的位置插入曲线，每次递增0.1，重复9次(repeat 9)，插入了9根曲线。自己修改下bfb的初始值，递增值及重复次数就可以了
来自: 微社区

王鹏_pBZlo · 发表于 2019-6-7 09:21:55

xdzcp 发表于 2019-6-5 14:58
大师说错了是希望能否改成输入自定义根数。

如果要n等分，把程序中的0.1修改成 (/ 1.0 n)，共2处；把程序中的9改成n,共1处
来自: 微社区

王鹏_pBZlo · 发表于 2019-6-7 09:23:19

xdzcp 发表于 2019-6-5 14:58
大师说错了是希望能否改成输入自定义根数。

说错了，应该是
如果要n等分，把程序中的0.1修改成 (/ 1.0 n)，共2处；
把程序中的9改成n-1,共1处
来自: 微社区

fengyun7000 · 发表于 2019-6-7 10:53:02

思路很巧妙啊，

王鹏_pBZlo · 发表于 2019-6-8 10:29:00

王鹏_pBZlo 发表于 2019-6-7 09:16
程序中的变量bfb初始值为0.1，即与第一条曲线距离与2曲线距离的比值为0.1的位置插入曲线，每次递增0.1， ...

;n等分,插入n-1根线
(defun c:djx( / ent1 ent2 num p1list p2list p3list i cp p1 bfb n)
      (prompt "\n插件目的:在选定的2条线之间插入n-1条等分线")
      (setq n (getint "\n输入等分数量n:"))
      (setq ent1 (car (entsel "\n[选择第1线条]:")))
      (setq ent2 (car (entsel"\n[选择第2线条]:")))
      (setq num 100)
      (if (ssget "x" (list (cons 0 "POINT"))) (command "erase" (ssget "x" (list (cons 0 "POINT"))) ""))
      (command "divide" ent1 num)
      (setq ent1 (ssget "x" (list (cons 0 "POINT"))))
      (setq p1list nil i 0)
      (while (setq cp (ssname ent1 i))
            (setq p1list (append p1list (list (cdr (assoc 10 (entget cp))))))
            (setq i (1+ i))
      )
      (command "erase" ent1 "")
      (command "divide" ent2 num)
      (setq ent2 (ssget "x" (list (cons 0 "POINT"))))
      (setq p2list nil i 0)
      (while (setq cp (ssname ent2 i))
            (setq p2list (append p2list (list (cdr (assoc 10 (entget cp))))))
            (setq i (1+ i))
      )
      (command "erase" ent2 "")
      (if (> (distance (nth 0 p1list) (nth 0 p2list)) (distance (nth 0 p1list) (nth (- num 2) p2list)))
         (setq p2list (reverse p2list))
      )
      (setq bfb (/ 1.0 n))
      (command "undo" "be")
      (repeat (1- n)
      (setq i 0 p3list nil)
      (while (and (setq cp (nth i p1list)) (setq cp1 (nth i p2list)))
            (setq p3 (list (+ (car cp) (* (- (car cp1) (car cp)) bfb)) (+ (cadr cp) (* (- (cadr cp1) (cadr cp)) bfb))))
            (setq p3list (append p3list (list p3)) i (1+ i))
      )

      (setq temposm (getvar "osmode"))
      (setvar "osmode" 0)
      (setq i 2 p1 (nth 0 p3list) cp (nth 1 p3list))
      (command "pline" (trans p1 0 1) (trans cp 0 1) "")
      (setq ent1 (entlast) p1 cp)
      (while (setq cp (nth i p3list))
            (command "line" (trans p1 0 1) (trans cp 0 1) "")
            (command "pedit" ent1 "J" (entlast) "" "")
            (setq p1 cp i (1+ i))
      )
      (command "change" (entlast) "" "P" "C" "3" "")
      (setq bfb (+ bfb (/ 1.0 n)))
      )
      (setvar "osmode" temposm)
      (command "undo" "e")
      (princ)
)

pxr201419 · 发表于 2019-6-8 10:57:51

王老师思路巧妙，如果线条有交点，在交点处有点缺憾。这里对您的程序做了些修改，请多指正
(defun c:df( / ent1 ent2 strr1 strr2 p11 p12 p21 p22 num p1list p2list p3list i ii cp p1 bfb ss)
(if (/= sss nil)(command "erase" sss ""))
(setvar "cmdecho" 0)(setvar "osmode" 0)
(if (ssget "x" (list (cons 0 "POINT"))) (command "erase" (ssget "x" (list (cons 0 "POINT"))) ""))
(setq ent1 (car (entsel "\n[选择第1线条]:")) ent2 (car (entsel "\n[选择第2线条]:")))
(setq strr1 (entget ent1) strr2 (entget ent2))
(setq p11 (vLax-Curve-getStartPoint ent1) p12 (vLax-curve-getEndPoint ent1))
    (setq p21 (vLax-Curve-getStartPoint ent2) p22 (vLax-curve-getEndPoint ent2))
(zpl)
(setq p21 (vLax-Curve-getStartPoint ent2) p22 (vLax-curve-getEndPoint ent2))
(if (> (distance p11 p21) (distance p11 p22))(fx1))
(setq p21 (vLax-Curve-getStartPoint ent2) p22 (vLax-curve-getEndPoint ent2))
(setq stjd nil stds nil jd nil)
(if (setq jd (vlax-invoke (vlax-ename->vla-object Ent1)'IntersectWith (vlax-ename->vla-object ent2) 0))
(progn (setq i 0)
(while (< i (length jd))
(setq stjd (cons (list (nth i jd)(nth (+ i 1) jd)(nth (+ i 2) jd)) stjd) i (+ i 3)))
(if (> (length stjd) 1)
(progn
(foreach x stjd (setq stds (cons (vlax-curve-getdistatpoint ent1 x) stds)))
      (setq stds1 nil stmd nil)
      (repeat (1- (length stjd))
      (setq md (apply 'max stds))
      (setq ii 0)
(while (/= md (nth ii stds))(setq ii (1+ ii)))
      (setq stmd (cons md stmd))
      (setq stds1 (cons (nth ii stjd) stds1))
      (setq stjd (vl-remove nil (mapcar '(lambda (x) (if (member x stds1) nil  x)) stjd)))
      (setq stds (vl-remove nil (mapcar '(lambda (x) (if (member x stmd) nil  x)) stds)))
   )
      (setq stds (cons (nth 0 stds) stmd))
      (setq stjd (reverse (cons (nth 0 stjd) stds1)))
) )
(setq str1 (reverse (cons p12 (reverse (cons p11 stjd)))) str2 (reverse (cons p22 (reverse (cons p21 stjd)))))
(setq nds (length str1) i 1 num 50 p1list nil p2list nil)
(while (< i (1- nds))
(setq p0 (nth i str1))
(command "break" ent1 p0 p0)
(setq ent10 (entlast))
(command "divide" ent1 num)
(setq ss1 (ssget "x" (list (cons 0 "POINT"))))
(setq  ii (- num 2) p1list (cons (nth (1- i) str1) p1list))
(while (>= ii 0)
      (setq cp (ssname ss1 ii))
(setq p1list (cons (cdr (assoc 10 (entget cp))) p1list) ii (1- ii)))
(command "erase" ss1 "")(command "erase" ent1 "")
(command "break" ent2 p0 p0)
(setq ent20 (entlast))
(command "divide" ent2 num)
(setq ss1 (ssget "x" (list (cons 0 "POINT"))))
(setq  ii (- num 2) p2list (cons (nth (1- i) str2) p2list))
(while (>= ii 0)
      (setq cp (ssname ss1 ii))
(setq p2list (cons (cdr (assoc 10 (entget cp))) p2list) ii (1- ii)))
(command "erase" ss1 "")(command "erase" ent2 "")
      (setq ent1 ent10 ent2 ent20)
(setq i (1+ i))    )
    (command "divide" ent1 num)
(setq ss1 (ssget "x" (list (cons 0 "POINT"))))
(setq  ii (- num 2) p1list (cons (nth (1- i) str1) p1list))
(while (>= ii 0)
      (setq cp (ssname ss1 ii))
(setq p1list (cons (cdr (assoc 10 (entget cp))) p1list) ii (1- ii)))
(setq p1list (cons (nth i str1) p1list))
(command "erase" ss1 "")(command "erase" ent1 "")
(command "divide" ent2 num)
(setq ss1 (ssget "x" (list (cons 0 "POINT"))))
(setq  ii (- num 2) p2list (cons (nth (1- i) str2) p2list))
(while (>= ii 0)
      (setq cp (ssname ss1 ii))
(setq p2list (cons (cdr (assoc 10 (entget cp))) p2list) ii (1- ii)))
(setq p2list (cons (nth i str2) p2list))
(command "erase" ss1 "")(command "erase" ent2 "")
(entmake strr1)(entmake strr2)
(ht) )
(wj) )
    (setvar "cmdecho" 0)
(princ) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun fx1()
(command "T81_TRevPline" ent2)
(setq p21 (vLax-Curve-getStartPoint ent2) p22 (vLax-curve-getEndPoint ent2) stjd nil jd nil) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zpL()
(setq lb (cdr (assoc 0 (entget ent2))))
(if (/= lb "LWPOLYLINE")
(cond ((= lb "LINE")(progn (command "pedit" ent2 "y" "")(setq ent2 (entlast))))
((= lb "ARC")(progn (command "pedit" ent2 "y" "")(setq ent2 (entlast))))
((= lb "POLYLINE")(progn (command "pedit" ent2 "")(setq ent2 (entlast))))
(t (zcc))) ) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zcc()
(if (setq e (ssget "aLL" '((0 . "point"))))(command "erase" e ""))
(setq num 100)
(command "divide" ent2 num)
(command "erase" ent2 "")
    (setq e (ssget "aLL" '((0 . "point"))))
(setq st1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 90 (+ 2 (sslength e)))))
    (setq st1 (append st1 (list (cons 10 p22))) mi 0)
(repeat (sslength e)
      (setq st1 (append st1 (list (assoc 10 (entget (ssname e mi)))  )))
      (setq mi (1+ mi)) )
    (setq st1 (append st1 (list (cons 10 p21))))
(entmake st1)
(command "erase" e "")
(setq ent2 (entlast)) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wj()
(setq num 50)
(command "divide" ent1 num)
(setq ss1 (ssget "x" (list (cons 0 "POINT"))))
(setq p1list nil i 0 p1list (cons p12 p1list))
(while (setq cp (ssname ss1 i))
(setq p1list (cons (cdr (assoc 10 (entget cp))) p1list) i (1+ i)))
(setq p1list (cons p11 p1list))
(command "erase" ss1 "")
(command "divide" ent2 num)
(setq ss2 (ssget "x" (list (cons 0 "POINT"))))
(setq p2list nil i 0 p2list (cons p22 p2list))
(while (setq cp (ssname ss2 i))
(setq p2list (cons (cdr (assoc 10 (entget cp))) p2list) i (1+ i)))
(setq p2list (cons p21 p2list))
(command "erase" ss2 "")
(ht) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ht()
(setq ts 5)
(if (SETQ ts1 (getint (strcat "\n输入线条数目<" (rtos ts) ">:")))(setq ts ts1))
(setq yss 20)
(if (SETQ yss1 (getint (strcat "\n输入等分线颜色数值(1~20)<" (rtos yss) ">:")))(setq yss yss1))
(setq bfb (/ 1.0 (1+ ts)) nts 1 ii 0)(SETQ YS1 (/ pi (1- ts)))
(setq sss (ssadd))
(repeat ts
(setq i 0 p3list nil)
(while (and (setq cp (nth i p1list)) (setq cp1 (nth i p2list)))
(setq p3 (list (+ (car cp) (* (- (car cp1) (car cp)) (* bfb nts))) (+ (cadr cp) (* (- (cadr cp1) (cadr cp)) (* bfb nts)))))
(setq p3list (append p3list (list p3)) i (1+ i)))
(setq st1 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 90 (length p3list))))
(setq mi 0)
(repeat (length p3list)
      (setq st1 (append st1 (list (cons 10 (nth mi p3list)) )))
      (setq mi (1+ mi)) )
(entmake st1)
(ssadd (entlast) sss)
(setq ys (+ (* yss 10) (fix  (* (sin (* ii ys1)) 30) ) ) )
(command "change" (entlast) "" "P" "C" (rtos ys) "")
(setq nts (1+ nts) ii (1+ ii))
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prompt "\n等阶线示例，命令：df")(princ)

王鹏_pBZlo · 发表于 2019-6-8 14:30:49

从你的程序中又学到了几个函数，比如获得曲线的起点和终点。我对vlax系列的函数知道的很少。会好好研究一下你的程序，可以改进一下我以前编的插件。你比我高明。
来自: 微社区

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

[求助] 两曲线之间插入等距曲线插件

点评

浏览过的版块

[求助] 两曲线之间插入等距曲线 插件

点评

浏览过的版块

[求助] 两曲线之间插入等距曲线插件