SLdesign（三领）Breaks

尘缘一生

看到本坛文字打断，分两组问题，思量这个用得不多，但是还是有时候用的，

http://bbs.mjtd.com/thread-191760-1-1.html
以目前三领的集成函数，作了一下子，与线类打断作在一起，我喜欢一个同样功能在一起画图，这样子，不用那么多的命令。

2. ;;SLdesign V3.0 三领打断（简版） BY 尘缘一生
   
3. ;;如果文字,动态指示打断位置
   
4. ;;如果线类,选择打断第二点时右键或空格则打断于点
   
5. (defun c:sldaduan (/ ent p0 p1 p2 p3 p4 e tp ang e_lst plis)
   
6.   (setq e_lst (sysvar '("OSMODE" "CMDECHO")))
   
7.   (setvar "CMDECHO" 0)
   
8.   (setq e (car (setq ent (entsel "\n 选择要打断的对象:"))))
   
9.   (setq tp (dxf1 e 0))
   
10.   ;(if (member tp '("ELLIPSE" "CIRCLE" "POLYLINE" "REGION" "MLINE" "3DFACE"))
    
11.   ;  (progn (gx (ssadd e) nil) (setq e (entlast) ent (list (entlast) (cadr ent)))) ;重新构建 entsel
    
12.   ;)
    
13.   (if (member tp '("TEXT" "TCH_TEXT" "MTEXT" "TCH_MTEXT"))
    
14.     (progn
    
15.       (setvar "OSMODE" 0)
    
16.       (setq p0 (car (ddslx (+ (e-ang e nil) pi2)))) ;;ddslx 动态定位矢量线函数 e-ang 实体角度函数
    
17.       (setq plis (maxtxbox (e-box4 e)) p1 (car plis) p2 (cadr plis) p3 (caddr plis) p4 (cadddr plis)) ;e-box4 包容盒4点位 maxtxbox 扩大10%包容盒4点位
    
18.       (sl_text:breakall e) ;文字原位打断函数
    
19.       (if (setq ss (ssget "W" p1 (pertolinecz p0 p4 p3) '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT")))) ;pertolinecz p0到p3 p4两点垂足
    
20.         (sswzhb ss) ;合并文字选择集左侧
    
21.       )
    
22.       (if (setq ss (ssget "W" (pertolinecz p0 p1 p2) p3 '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))))
    
23.         (sswzhb ss) ;合并文字选择集右侧
    
24.       )
    
25.     )
    
26.     (progn ;线类
    
27.       (setvar "OSMODE" 16383)
    
28.       (setq ang (+ (e-ang e nil) pi4))
    
29.       (if (setq p1 (getpoint "\n 指定打断的第一点:"))
    
30.         (progn (setq p1 (vlax-curve-getClosestPointTo e p1 nil)) (slslx p1 ang))
    
31.       )
    
32.       (if (setq p2 (getpoint "\n 指定打断的第二点 , 或打断于点<右键>:"))
    
33.         (progn (setq p2 (vlax-curve-getClosestPointTo e p2 nil)) (slslx p2 ang))
    
34.       )
    
35.       (setvar "OSMODE" 0)
    
36.       (if p2
    
37.         (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "_non" (trans p2 0 1))
    
38.         (if (if-color)
    
39.           (progn
    
40.             (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@")
    
41.             (vla-put-color (en2obj (entlast)) (atoi (slsjqs)))
    
42.           )
    
43.           (progn (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@") (redraw (entlast) 3))
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48.   (mapcar 'eval e_lst)
    
49.   (redraw)
    
50.   (princ)
    
51. )

;;SLdesign V3.0 三领打断（简版） BY 尘缘一生 <br /> ;;如果文字,动态指示打断位置<br /> ;;如果线类,选择打断第二点时右键或空格则打断于点<br /> (defun c:sldaduan (/ ent p0 p1 p2 p3 p4 e tp ang e_lst plis)<br />   (setq e_lst (sysvar '("OSMODE" "CMDECHO")))<br />   (setvar "CMDECHO" 0)<br />   (setq e (car (setq ent (entsel "\n 选择要打断的对象:"))))<br />   (setq tp (dxf1 e 0))<br />   ;(if (member tp '("ELLIPSE" "CIRCLE" "POLYLINE" "REGION" "MLINE" "3DFACE")) <br />   ;  (progn (gx (ssadd e) nil) (setq e (entlast) ent (list (entlast) (cadr ent)))) ;重新构建 entsel<br />   ;)<br />   (if (member tp '("TEXT" "TCH_TEXT" "MTEXT" "TCH_MTEXT"))<br />     (progn <br />       (setvar "OSMODE" 0)<br />       (setq p0 (car (ddslx (+ (e-ang e nil) pi2)))) ;;ddslx 动态定位矢量线函数 e-ang 实体角度函数<br />       (setq plis (maxtxbox (e-box4 e)) p1 (car plis) p2 (cadr plis) p3 (caddr plis) p4 (cadddr plis)) ;e-box4 包容盒4点位 maxtxbox 扩大10%包容盒4点位<br />       (sl_text:breakall e) ;文字原位打断函数<br />       (if (setq ss (ssget "W" p1 (pertolinecz p0 p4 p3) '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT")))) ;pertolinecz p0到p3 p4两点垂足<br />         (sswzhb ss) ;合并文字选择集左侧<br />       )<br />       (if (setq ss (ssget "W" (pertolinecz p0 p1 p2) p3 '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))))<br />         (sswzhb ss) ;合并文字选择集右侧<br />       )<br />     )<br />     (progn ;线类<br />       (setvar "OSMODE" 16383)<br />       (setq ang (+ (e-ang e nil) pi4))<br />       (if (setq p1 (getpoint "\n 指定打断的第一点:"))<br />         (progn (setq p1 (vlax-curve-getClosestPointTo e p1 nil)) (slslx p1 ang))<br />       )<br />       (if (setq p2 (getpoint "\n 指定打断的第二点 , 或打断于点<右键>:"))<br />         (progn (setq p2 (vlax-curve-getClosestPointTo e p2 nil)) (slslx p2 ang))<br />       )<br />       (setvar "OSMODE" 0)<br />       (if p2<br />         (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "_non" (trans p2 0 1))<br />         (if (if-color)<br />           (progn<br />             (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@")<br />             (vla-put-color (en2obj (entlast)) (atoi (slsjqs)))<br />           )<br />           (progn (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@") (redraw (entlast) 3))<br />         )<br />       )<br />     )<br />   )<br />   (mapcar 'eval e_lst)<br />   (redraw)<br />   (princ)<br /> )

说明：文字有稍微移位，实际不是原位炸开函数不完美，是再合并函数还没有加原位不变这一部分，不属于本问题。

lzspain

运行出错
命令: SLDADUAN
; 错误: no function definition: SYSVAR

尘缘一生

lzspain 发表于 2024-12-19 12:06
运行出错
命令: SLDADUAN
; 错误: no function definition: SYSVAR

变量保存的一种办法

2. ;;存储系统变量----(一级)----
   
3. ;;lis 系统变量表 '("OSMODE" "CMDECHO" "ORTHOMODE")
   
4. (defun sysvar (lis / n)
   
5.   (setq e_lst (remove-nil (mapcar (function (lambda (n) (if (getvar n) (list 'setvar n (getvar n))))) lis)))
   
6.   e_lst
   
7. )

;;存储系统变量----(一级)----<br /> ;;lis 系统变量表 '("OSMODE" "CMDECHO" "ORTHOMODE")<br /> (defun sysvar (lis / n)<br />   (setq e_lst (remove-nil (mapcar (function (lambda (n) (if (getvar n) (list 'setvar n (getvar n))))) lis)))<br />   e_lst<br /> )

lzspain

尘缘一生 发表于 2024-12-19 17:58
变量保存的一种办法

还是不行，又会报其他的REMOVE-NIL、DXF1错误，没安装三领不能用吗？

尘缘一生

lzspain 发表于 2024-12-19 20:04
还是不行，又会报其他的REMOVE-NIL、DXF1错误，没安装三领不能用吗？

不好意思兄弟：我刚才看了下子，不行，下面啊，函数更多，没法一一弄出来，如果弄，我都得改写一遍所有函数，本坛其他地方有，但三领的不一样，集成太多，DXF1那句这样 (setq tp (cdr (assoc 0 (entget e))))

2. ;;SLdesign V3.0 三领打断（简版） BY 尘缘一生
   
3. ;;如果文字,动态指示打断位置
   
4. ;;如果线类,选择打断第二点时右键或空格则打断于点
   
5. (defun c:sldaduan (/ ent p0 p1 p2 p3 p4 e tp ang e_lst plis)
   
6.         (setq e_lst (sysvar '("OSMODE" "CMDECHO")))
   
7.         (setvar "CMDECHO" 0)
   
8.         (setq e (car (setq ent (entsel "\n 选择要打断的对象:"))))
   
9.         (setq tp (cdr (assoc 0 (entget e))))
   
10.         ;(if (member tp '("ELLIPSE" "CIRCLE" "POLYLINE" "REGION" "MLINE" "3DFACE"))
    
11.         ;        (progn (gx (ssadd e) nil) (setq e (entlast) ent (list (entlast) (cadr ent)))) ;重新构建 entsel
    
12.         ;)
    
13.         (if (member tp '("TEXT" "TCH_TEXT" "MTEXT" "TCH_MTEXT"))
    
14.                 (progn
    
15.                         (setvar "OSMODE" 0)
    
16.                         (setq p0 (car (ddslx (+ (e-ang e nil) pi2)))) ;;ddslx 动态定位矢量线函数 e-ang 实体角度函数
    
17.                         (setq plis (maxtxbox (e-box4 e)) p1 (car plis) p2 (cadr plis) p3 (caddr plis) p4 (cadddr plis)) ;e-box4 包容盒3点位 maxtxbox 扩大10%包容盒
    
18.                         (sl_text:breakall e) ;文字原位打断函数
    
19.                         (if (setq ss (ssget "W" p1 (pertolinecz p0 p4 p3) '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT")))) ;pertolinecz p0到p3 p4两点垂足
    
20.                                 (sswzhb ss) ;合并文字选择集左侧
    
21.                         )
    
22.                         (if (setq ss (ssget "W" (pertolinecz p0 p1 p2) p3 '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))))
    
23.                                 (sswzhb ss) ;合并文字选择集右侧
    
24.                         )
    
25.                 )
    
26.                 (progn ;线类
    
27.                         (setvar "OSMODE" 16383)
    
28.                         (setq ang (+ (e-ang e nil) pi4))
    
29.                         (if (setq p1 (getpoint "\n 指定打断的第一点:"))
    
30.                                 (progn (setq p1 (vlax-curve-getClosestPointTo e p1 nil)) (slslx p1 ang))
    
31.                         )
    
32.                         (if (setq p2 (getpoint "\n 指定打断的第二点 , 或打断于点<右键>:"))
    
33.                                 (progn (setq p2 (vlax-curve-getClosestPointTo e p2 nil)) (slslx p2 ang))
    
34.                         )
    
35.                         (setvar "OSMODE" 0)
    
36.                         (if p2
    
37.                                 (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "_non" (trans p2 0 1))
    
38.                                 (progn (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@") (redraw (entlast) 3))
    
39.                         )
    
40.                 )
    
41.         )
    
42.         (mapcar 'eval e_lst)
    
43.         (redraw)
    
44.         (princ)
    
45. )

;;SLdesign V3.0 三领打断（简版） BY 尘缘一生 <br /> ;;如果文字,动态指示打断位置<br /> ;;如果线类,选择打断第二点时右键或空格则打断于点<br /> (defun c:sldaduan (/ ent p0 p1 p2 p3 p4 e tp ang e_lst plis)<br />         (setq e_lst (sysvar '("OSMODE" "CMDECHO")))<br />         (setvar "CMDECHO" 0)<br />         (setq e (car (setq ent (entsel "\n 选择要打断的对象:"))))<br />         (setq tp (cdr (assoc 0 (entget e))))<br />         ;(if (member tp '("ELLIPSE" "CIRCLE" "POLYLINE" "REGION" "MLINE" "3DFACE")) <br />         ;        (progn (gx (ssadd e) nil) (setq e (entlast) ent (list (entlast) (cadr ent)))) ;重新构建 entsel<br />         ;)<br />         (if (member tp '("TEXT" "TCH_TEXT" "MTEXT" "TCH_MTEXT"))<br />                 (progn <br />                         (setvar "OSMODE" 0)<br />                         (setq p0 (car (ddslx (+ (e-ang e nil) pi2)))) ;;ddslx 动态定位矢量线函数 e-ang 实体角度函数<br />                         (setq plis (maxtxbox (e-box4 e)) p1 (car plis) p2 (cadr plis) p3 (caddr plis) p4 (cadddr plis)) ;e-box4 包容盒3点位 maxtxbox 扩大10%包容盒<br />                         (sl_text:breakall e) ;文字原位打断函数<br />                         (if (setq ss (ssget "W" p1 (pertolinecz p0 p4 p3) '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT")))) ;pertolinecz p0到p3 p4两点垂足<br />                                 (sswzhb ss) ;合并文字选择集左侧<br />                         )<br />                         (if (setq ss (ssget "W" (pertolinecz p0 p1 p2) p3 '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))))<br />                                 (sswzhb ss) ;合并文字选择集右侧<br />                         )<br />                 )<br />                 (progn ;线类<br />                         (setvar "OSMODE" 16383)<br />                         (setq ang (+ (e-ang e nil) pi4))<br />                         (if (setq p1 (getpoint "\n 指定打断的第一点:"))<br />                                 (progn (setq p1 (vlax-curve-getClosestPointTo e p1 nil)) (slslx p1 ang))<br />                         )<br />                         (if (setq p2 (getpoint "\n 指定打断的第二点 , 或打断于点<右键>:"))<br />                                 (progn (setq p2 (vlax-curve-getClosestPointTo e p2 nil)) (slslx p2 ang))<br />                         )<br />                         (setvar "OSMODE" 0)<br />                         (if p2<br />                                 (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "_non" (trans p2 0 1))<br />                                 (progn (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@") (redraw (entlast) 3))<br />                         )<br />                 )<br />         )<br />         (mapcar 'eval e_lst)<br />         (redraw)<br />         (princ)<br /> )