yang686526

求助顾老师修改下面按给定任意长度打断图元的。lsp
www.dimcax.com
求助顾老师修改下面按给定任意长度打断图元的。lsp
我想能否辛苦你修改一下，按指定的线段长度打断各种图元，比如一段弧长，指定长度（含有小数）整数和小数都可以，要有给定数据的提示，谢谢！
(vl-load-com)
;;;===============================================
;;;通用函数 将圆等分打断
(defun break-circle (en n / enl pt0 r ang0 ang1 angi)
(if (and (> n 1)
(setq enl (entget en))
(= (cdr (assoc 0 enl)) "circle")
)
(progn
(setq pt0 (cdr (assoc 10 enl))
r (cdr (assoc 40 enl))
)
;;创建n个圆弧
(setq ang0 0.0
angi (/ pi 0.5 n) ;_每个圆弧所对圆心角
)
(repeat n
(setq ang1 (+ ang0 angi))
;;创建圆弧
(entmake (list (cons 0 "arc")
(cons 10 pt0)
(cons 40 r)
(cons 50 ang0)
(cons 51 ang1)
)
)
(setq ang0 ang1)
)
;;删除自身
(entdel en)
)
)
)
;;;===============================================
;;;通用函数 将指定线对象en按照指定数目n等分打断。
(defun break-test (en n / obj len leni pt pt_lst)
(and ;;判断参数有效性
(> n 1)
;;转换对象名类型
(setq obj (vlax-ename->vla-object en))
;;获取对象总长度
(setq len (vlax-curve-getdistatpoint
obj
(vlax-curve-getendpoint obj)
)
)
;;计算等分点位
(setq pt_lst '() ;_存放等分点位的表
leni (/ len 1.0 n)
len 0
)
(repeat (1- n)
(setq len (+ len leni)
pt (vlax-curve-getpointatdist obj len)
pt_lst (cons pt pt_lst)
)
)
;;进行等分操作
(foreach pt pt_lst
(command "_.break" (list en pt) "f" "non" pt "non" pt)
)
)
)
;;;===============================================
(defun c:dfdd (/ ss n i)
(if (and (princ "\n选择要等分打断的线元...")
(setq ss (ssget '((0 . "line,arc,lwpolyline,spline,circle")))
)
(setq n (getint "\n***分段数: "))
(> n 1)
(setq i 0)
)
(repeat (sslength ss)
(setq en (ssname ss i))
(if (= (cdr (assoc 0 (entget en))) "circle")
(break-circle en n) ;_调用函数，等分圆为圆弧
(break-test en n) ;_调用函数，打断操作
)
(setq i (1+ i))
)
)
(princ)
)

我用了一下你的程序,基本没错,只是在打断时要显示打断命令.改后见下:
(vl-load-com)
;;;===============================================
;;;通用函数 将圆等分打断
(defun break-circle (en n / enl pt0 r ang0 ang1 angi)
(if (and (> n 1)
(setq enl (entget en))
(= (cdr (assoc 0 enl)) "circle")
)
(progn
(setq pt0 (cdr (assoc 10 enl))
r (cdr (assoc 40 enl))
)
;;创建n个圆弧
(setq ang0 0.0
angi (/ pi 0.5 n) ;_每个圆弧所对圆心角
)
(repeat n
(setq ang1 (+ ang0 angi))
;;创建圆弧
(entmake (list (cons 0 "arc")
(cons 10 pt0)
(cons 40 r)
(cons 50 ang0)
(cons 51 ang1)
)
)
(setq ang0 ang1)
)
;;删除自身
(entdel en)
)
)
)
;;;===============================================
;;;通用函数 将指定线对象en按照指定数目n等分打断。
(defun break-test (en n / obj len leni pt pt_lst)
(and ;;判断参数有效性
(> n 1) ;;转换对象名类型
(setq obj (vlax-ename->vla-object en)) ;;获取对象总长度
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))) ;;计算等分点位
(setq pt_lst '() leni (/ len 1.0 n) len 0 );_存放等分点位的表
(repeat (1- n)
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst))
) ;;进行等分操作
(foreach pt pt_lst
(command "_.break" (list en pt) "f" "non" pt "non" pt)
)
)
)
;;;===============================================
(defun c:dfdd (/ ss n i)
(setq os (getvar "osmode") cm (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(if (and (princ "\n选择要等分打断的线元...")
(setq ss (ssget '((0 . "line,arc,lwpolyline,spline,circle")))
)
(setq n (getint "\n***分段数: "))
(> n 1)
(setq i 0)
)
(repeat (sslength ss)
(setq en (ssname ss i))
(if (= (cdr (assoc 0 (entget en))) "circle")
(break-circle en n) ;_调用函数，等分圆为圆弧
(break-test en n) ;_调用函数，打断操作
)
(setq i (1+ i))
)
)
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)
gbg

你好，顾老师，是我说的问题含糊，这是个按平均数目打断的源程序，程序本身没问题。我是想按我的意思修改一下，打个比方，一段203.36米长的弧或直线，开始按3.36米打断，剩余200米长度有提示。接下来200米长度可以按整数20或10米打断也可以按4.52米长度打断，也就是说这个指定长度是任意给定，但是每打断一次要有剩余的长度提示，以便随着进度掌握打断的长度。

顾老师，你现在一定很忙，我上面说的意思能否可行？

该程序可对你选择的图素一个一个的分别处理,在你选择的图素为你好区分改变了它层,在你输入后把层又改回来,进行分割,
它有定长和等段数两种,定长它的余长在图上你可删除.
(if (not (tblsearch "layer" "5"))
(command "layer" "n" "5" "c" "1" "5" "")
)
(vl-load-com)
(defun c:dfddd (/ en len leni ss n i)
(setq os (getvar "osmode") cm (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(prompt "\n选择要等分打断的线元...")
(setq ss (ssget '((0 . "line,arc,lwpolyline,spline,circle"))) i 0)
(repeat (sslength ss)
(setq en (ssname ss i) en1 (entget en) la (cdr (assoc 8 en1)) )
(setq en1 (subst (cons 8 "5")(assoc 8 en1)en1))
(entmod en1)
(if (= (cdr (assoc 0 en1)) "circle")
(progn
(setq n (getint "\n***分段数: "))
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1)
(if (> n 1)
(progn
(setq enl (entget en) pt0 (cdr (assoc 10 enl)) r (cdr (assoc 40 enl))) ;;创建n个圆弧
(setq ang0 0.0 angi (/ pi 0.5 n)) ;_每个圆弧所对圆心角
(repeat n
(setq ang1 (+ ang0 angi)) ;;创建圆弧
(entmake (list (cons 0 "arc")
(cons 10 pt0)
(cons 40 r)
(cons 50 ang0)
(cons 51 ang1)
)
)
(setq ang0 ang1)
) ;;删除自身
(entdel en)
)))
(progn
(setq obj (vlax-ename->vla-object en)) ;;获取对象总长度
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))) ;;计算等分点位
(prompt (strcat "它的实际长度为" (rtos len 2 4)))
(setq nn (getstring "\n定长(1) 定分段数: 2 输入1 回车为定长 "))
(if (= nn "")(setq nn "1"))
(if (= nn "1")
(progn
(prompt (strcat (rtos len 2 0) " 输入你要的分段长度: "))
(setq leni (getreal) n (fix(/ len leni)) pt_lst '() len 0 )
(repeat n
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst))
) ;;进行等分操作
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1) ;把层返回
(foreach pt pt_lst
(command "_.break" (list en pt) "f" "non" pt "non" pt)
)
)
(progn
(setq n (getint "\n***分段数: ") pt_lst '() leni (/ len 1.0 n) len 0 );_存放等分点位的表
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1)
(repeat (1- n)
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst))
) ;;进行等分操作
(foreach pt pt_lst
(command "_.break" (list en pt) "f" "non" pt "non" pt)
)
))))
(setq i (1+ i))
)
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)
gbg

你好，顾老师，我试了一下，可以用的，哈哈，就是和我的意思还是不太一样的，你的程序是按任意给定长度打断，这些段都是定长。我的意思是，比如一条线段，开始第一段可能是这个任意数。第二段又是另外一个任意数，每打断一次，要有余长的显示（就是未断开前的线段长减掉每次给定的任意长）开始第一段打断方向最好有个提示，是从线段那端开始。程序其他修改处都好，不知道我说的可行否？谢谢！

我拿朋友的东西用了！谢谢！

我试用了效果不错！谢谢朋友和顾老师的提供！

下面为你要的分为任意长度的程序.
(defun c:dfdd (/ en len leni ss n i)
(setq os (getvar "osmode") cm (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(prompt "\n选择要等分打断的线元...")
(setq ss (ssget '((0 . "line,arc,lwpolyline,spline"))) i 0)
(repeat (sslength ss)
(setq en (ssname ss i) en1 (entget en) la (cdr (assoc 8 en1)) )
(setq en1 (subst (cons 8 "5")(assoc 8 en1)en1))
(entmod en1)
(setq obj (vlax-ename->vla-object en)) ;;获取对象总长度
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)) len2 len) ;;计算等分点位
;(prompt (strcat "它的实际长度为" (rtos len 2 4)))
(setq pt_lst '() len 0 )
(while ss
(prompt (strcat (rtos len2 2 4) " 输入你要的分段长度: 回车退出 "))(terpri)
(setq leni (getreal))
(if (= leni nil)(setq ss nil)
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst) len2 (- len2 len)))
;;进行等分操作
)
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1) ;把层返回
(foreach pt pt_lst
(command "_.break" (list en pt) "f" "non" pt "non" pt)
)
(setq i (1+ i))
)
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)
gbg

顾老师，你好！我试了你刚刚修改的程序，这次好多了，美中不足的是---图元打断顺序始终是按着由下到上，又左到右进行，能否修改一下图元选择后，按着操作人员意思选择图元这端或另外一端开始打断呢？打断方向选择很重要。再次感谢！

按你的意思改了,
定长, 定分段数, 分任意长度 .
在分任意长度中可反时针分段(1),顺时针分段(2)
(if (not (tblsearch "layer" "5"))
(command "layer" "n" "5" "c" "1" "5" "")
)
(vl-load-com)
(defun c:dfdd (/ os cm ss en en1 la xi een p1 obj pt pt_lst leni n i )
(setq os (getvar "osmode") cm (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(prompt "\n选择要等分打断的线元...")
(setq ss (ssget '((0 . "line,arc,lwpolyline,spline,circle"))) i 0)
(repeat (sslength ss)
(setq en (ssname ss i) en1 (entget en) la (cdr (assoc 8 en1)) xi (cdr (assoc 0 en1)) een (cdr (assoc 5 en1)))
(if (/= xi "circle")
(progn
(setq en1 (subst (cons 8 "5")(assoc 8 en1)en1))
(entmod en1)
)
(progn
(setq r (cdr (assoc 40 en1)) pc (cdr (assoc 10 en1)) p1 (polar pc 0 r))
(command "break" p1 "f" p1 "@0,0.000001")
(setq enn (ssget p1) en (ssname enn 0) en1 (entget en) xi (cdr (assoc 0 en1)) een (cdr (assoc 5 en1)))
(setq en1 (subst (cons 8 "5")(assoc 8 en1)en1))
(entmod en1)
))
(if (= nn "")(setq nn "1"))
(setq obj (vlax-ename->vla-object en)) ;;获取对象总长度
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))) ;;计算等分点位
(prompt (strcat "它的实际长度为" (rtos len 2 4)))
(setq nn (getstring "\n定长(1) 定分段数:2 分任意长度3 输入1 回车为定长 "))
(if (= nn "")(setq nn "1"))
(if (= nn "1")
(progn
(prompt (strcat (rtos len 2 0) " 输入你要的分段长度: "))
(setq leni (getreal) n (fix(/ len leni)) pt_lst '() len 0 )
(repeat n ;(1- n)
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst))
) ;;进行等分操作
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1) ;把层返回
(setq n (length pt_lst) h 0)
(repeat n
(command "_.break" (nth h pt_lst) "@")
(setq h (+ h 1))
)
)
(if (= nn "2")
(progn
(setq n (getint "\n***分段数: ") pt_lst '() leni (/ len 1.0 n) len 0 );_存放等分点位的表
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1)
(repeat (1- n)
(setq len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst))
) ;;进行等分操作
(setq n (length pt_lst) h 0)
(repeat n
(command "_.break" (nth h pt_lst) "@")
(setq h (+ h 1))
)
)
(progn
(prompt "反时针分段(1),顺时针分段(2) 回车顺时针分段场: ")
(setq nnn (getstring ))
(if (or (= nnn "1")(= nnn ""))
(progn
(setq len2 len) ;;计算等分点位
(setq pt_lst '() len 0 sss 0)
(while sss
(prompt (strcat (rtos len2 2 4) " 输入你要的分段长度: 回车退出 "))(terpri)
(setq leni (getreal) )
(if (= leni nil)(setq sss nil)
(setq len2 (- len2 leni) len (+ len leni) pt (vlax-curve-getpointatdist obj len) pt_lst (cons pt pt_lst) ))
;;进行等分操作
)
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1) ) ;把层返回
(progn
(setq obj (vlax-ename->vla-object en)) ;;获取对象总长度
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)) len2 len) ;;计算等分点位
(setq pt_lst '() len 0 sss 0)
(while sss
(prompt (strcat (rtos len2 2 4) " 输入你要的分段长度: 回车退出 "))(terpri)
(setq leni (getreal) )
(if (= leni nil)(setq sss nil)
(setq len2 (- len2 leni) len (+ len leni) pt (vlax-curve-getpointatdist obj len2) pt_lst (cons pt pt_lst) ))
)
(setq en1 (subst (cons 8 la)(assoc 8 en1)en1))
(entmod en1) ;把层返回
))
(setq n (length pt_lst) h 0)
(repeat n
(command "_.break" (nth h pt_lst) "@")
(setq h (+ h 1))
)
)))
(setq i (1+ i) )
)
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)
gbg