线段打断等分成3段lisp

李青松

线段打断等分成3段
3个线变成单独的
3段我是举个例子
也可能是打断成4段等等
怎么写程序

夏生生

不一定对

1. (defun c:tt(/ dis en lst n os)
   
2. (setq os  (getvar "osmode")
   
3.        en  (car (entsel "\nSelect Object:"))
   
4.        n   (getint "\n等分数:")
   
5.        dis (/ (vlax-curve-getdistatparam
   
6.                en
   
7.                (vlax-curve-getendparam en))
   
8.               n
   
9.               1.)
   
10.        n   (1- n))
    
11. (setvar "osmode" 16419)
    
12. (repeat n
    
13.   (setq
    
14.    lst (cons (vlax-curve-getpointatdist en (* n dis)) lst)
    
15.    n   (1- n)))
    
16. (foreach n  lst
    
17.   (vl-cmdf "break" en "f" n "@")
    
18.   (setq en (entlast)))
    
19. (setvar "osmode" os))

(defun c:tt(/ dis en lst n os) <br /> (setq os  (getvar "osmode")<br />        en  (car (entsel "\nSelect Object:"))<br />        n   (getint "\n等分数:")<br />        dis (/ (vlax-curve-getdistatparam<br />                en<br />                (vlax-curve-getendparam en))<br />               n<br />               1.)<br />        n   (1- n))<br /> (setvar "osmode" 16419)<br /> (repeat n<br />   (setq<br />    lst (cons (vlax-curve-getpointatdist en (* n dis)) lst)<br />    n   (1- n)))<br /> (foreach n  lst<br />   (vl-cmdf "break" en "f" n "@")<br />   (setq en (entlast)))<br /> (setvar "osmode" os))

Andyhon

可以用Break不过...

偏方--->

但依等分后的线段长
算得各断点
删除原线

绘出第一条线后
可改用Copy
也可Line连结各点位

xyp1964

1. ;;需要E派系统的支持
   
2. (defun c:tt ()
   
3.   "曲线等分"
   
4.   (or nn(setq nn 5))
   
5.   (setq nn (Uint 1 "" "等分段数" nn))
   
6.   (setq s1 (car(entsel"\n选择线段: ")))
   
7.   (mapcar '(lambda (x) (xyp-BreakE s1 x x)) (reverse (xyp-CurveDivNum s1 nn)))
   
8.   (princ)
   
9. )

;;需要E派系统的支持<br /> (defun c:tt ()<br />   "曲线等分"<br />   (or nn(setq nn 5))<br />   (setq nn (Uint 1 "" "等分段数" nn))<br />   (setq s1 (car(entsel"\n选择线段: ")))<br />   (mapcar '(lambda (x) (xyp-BreakE s1 x x)) (reverse (xyp-CurveDivNum s1 nn)))<br />   (princ)<br /> )

李青松

xyp1964 发表于 2025-1-8 20:17

给个源码吧

Scarlet2001

用CAD原生的divide+breakatpoint写个lisp试试？

Scarlet2001

好像有个潜在问题，低版本貌似是没有breakatpoint命令的。。。

ymcui

2. (defun c:cv (/ ss x pe pm pc ang k p1)
   
3.   (setq ss (entsel "\n选取直线:"))
   
4.   (setq x (getreal "\n等分数:"))
   
5.   (setq pe (osnap (cadr ss) "END"))
   
6.   (setq pm (osnap (cadr ss) "MID"))
   
7.   (setq pc (mapcar '+ pm (mapcar '- pm pe)))
   
8.   (setq ang (angle pe pm))
   
9.   (setq k (/ (distance pe pc) x))
   
10.   (command "_erase" ss "")
    
11.   (while (> x 0)
    
12.     (setq x (1- x))
    
13.     (setq p1 (polar pe ang k))
    
14.     (command "line" pe p1 "")
    
15.     (setq pe p1)
    
16.   )
    
17.   (princ)
    
18. )

(defun c:cv (/ ss x pe pm pc ang k p1)<br />   (setq ss (entsel "\n选取直线:"))<br />   (setq x (getreal "\n等分数:"))<br />   (setq pe (osnap (cadr ss) "END"))<br />   (setq pm (osnap (cadr ss) "MID"))<br />   (setq pc (mapcar '+ pm (mapcar '- pm pe)))<br />   (setq ang (angle pe pm))<br />   (setq k (/ (distance pe pc) x))<br />   (command "_erase" ss "")<br />   (while (> x 0)<br />     (setq x (1- x))<br />     (setq p1 (polar pe ang k))<br />     (command "line" pe p1 "")<br />     (setq pe p1)<br />   )<br />   (princ)<br /> )

Scarlet2001

• ;支持多段线、曲线、直线（理论圆弧和圆也行，在第11行的if里修改一下起点终点判断就行）
• (defun c:DVV ( / l n k a pt ptlist ptalist pt1 pt2 xl)
•   (setvar "cmdecho" 0)
•   ;(setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
•   (setq l (entsel "\n选择要定数等分的对象"))
•   (setq n (getint "\n选择要定数等分的个数"))
•   (setq a (entget (car l)))
•   (entdel (car l))
•   (setq l (entmakex a))
•   (command "divide" l n)
•   (if (= "LINE" (cdr (assoc 0 a)))
•     (setq pt1 (cdr (assoc 10 a)) pt2 (cdr (assoc 11 a)))
•     (setq pt1 (cdr (assoc 10 a)) pt2 (cdr (assoc 10 (reverse a))))
•   )
•   (setq ptlist (list) ptalist (list))
•   (repeat (1- n)
•     (if pt (setq pt (entnext pt)) (setq pt (entnext l)))
•     (setq ptlist (cons (cdr (assoc 10 (entget pt))) ptlist))
•     (setq ptalist (cons pt ptalist))
•   )
•   (entdel l)
•   (setq ptlist (cons pt2 ptlist))
•   (setq ptlist (cons pt1 (reverse ptlist)))
•   (setq k 0)
•   (repeat n
•     (setq xl (entmakex a))
•     (command "break" xl (nth k ptlist) pt1)
•     (command "break" xl (nth (1+ k) ptlist) pt2)  
•     (setq k (1+ k))
•   )
•   (foreach pt ptalist (entdel pt))
•   (setvar "cmdecho" 1)
•   (prin1)
• )
  

uualice2020

• ;获取曲线等分点（不含端点,n为等分数量）
• (defun zx-CurveDivNum (en n / i pp pplis )
• (setq pplis '() i 0  )
• (repeat (-  n   1)
•   (setq pp(vlax-curve-getPointAtDist en
•           (*(/ (vlax-curve-getdistatparam en(vlax-curve-getendparam en)) n)
•                                           (setq i (1+ i))))
•   )
• (setq pplis (cons pp pplis))
• )
• pplis
• )
• ;根据曲线等分点打断曲线 （n为等分数量）
• (defun zx-Break(BreakE_enme n )
• (foreach x (zx-CurveDivNum BreakE_enme n )
•   (vl-cmdf "BREAK" (list BreakE_enme x) "f" "non" x "non" x)
• )
• )