SLdesign（三领）Breaks

尘缘一生 发表于 2024-12-18 20:18:53

本帖最后由尘缘一生于 2024-12-18 20:23 编辑

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

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

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

lzspain 发表于 2024-12-19 12:06:31

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

尘缘一生 发表于 2024-12-19 17:58:52

lzspain 发表于 2024-12-19 12:06
运行出错
命令: SLDADUAN
; 错误: no function definition: SYSVAR
变量保存的一种办法

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

lzspain 发表于 2024-12-19 20:04:54

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

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

尘缘一生 发表于 2024-12-19 20:44:41

本帖最后由尘缘一生于 2024-12-19 20:48 编辑

lzspain 发表于 2024-12-19 20:04
还是不行，又会报其他的REMOVE-NIL、DXF1错误，没安装三领不能用吗？
不好意思兄弟：我刚才看了下子，不行，下面啊，函数更多，没法一一弄出来，如果弄，我都得改写一遍所有函数，本坛其他地方有，但三领的不一样，集成太多，DXF1那句这样 (setq tp (cdr (assoc 0 (entget e))))
;;SLdesign V3.0 三领打断（简版） BY 尘缘一生
;;如果文字,动态指示打断位置
;;如果线类,选择打断第二点时右键或空格则打断于点
(defun c:sldaduan (/ ent p0 p1 p2 p3 p4 e tp ang e_lst plis)
   (setq e_lst (sysvar '("OSMODE" "CMDECHO")))
   (setvar "CMDECHO" 0)
   (setq e (car (setq ent (entsel "\n 选择要打断的对象:"))))
   (setq tp (cdr (assoc 0 (entget e))))
   ;(if (member tp '("ELLIPSE" "CIRCLE" "POLYLINE" "REGION" "MLINE" "3DFACE"))
   ;    (progn (gx (ssadd e) nil) (setq e (entlast) ent (list (entlast) (cadr ent)))) ;重新构建 entsel
   ;)
   (if (member tp '("TEXT" "TCH_TEXT" "MTEXT" "TCH_MTEXT"))
            (progn
                     (setvar "OSMODE" 0)
                     (setq p0 (car (ddslx (+ (e-ang e nil) pi2)))) ;;ddslx 动态定位矢量线函数 e-ang 实体角度函数
                     (setq plis (maxtxbox (e-box4 e)) p1 (car plis) p2 (cadr plis) p3 (caddr plis) p4 (cadddr plis)) ;e-box4 包容盒3点位 maxtxbox 扩大10%包容盒
                     (sl_text:breakall e) ;文字原位打断函数
                     (if (setq ss (ssget "W" p1 (pertolinecz p0 p4 p3) '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT")))) ;pertolinecz p0到p3 p4两点垂足
                           (sswzhb ss) ;合并文字选择集左侧
                     )
                     (if (setq ss (ssget "W" (pertolinecz p0 p1 p2) p3 '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))))
                           (sswzhb ss) ;合并文字选择集右侧
                     )
            )
            (progn ;线类
                     (setvar "OSMODE" 16383)
                     (setq ang (+ (e-ang e nil) pi4))
                     (if (setq p1 (getpoint "\n 指定打断的第一点:"))
                           (progn (setq p1 (vlax-curve-getClosestPointTo e p1 nil)) (slslx p1 ang))
                     )
                     (if (setq p2 (getpoint "\n 指定打断的第二点 , 或打断于点<右键>:"))
                           (progn (setq p2 (vlax-curve-getClosestPointTo e p2 nil)) (slslx p2 ang))
                     )
                     (setvar "OSMODE" 0)
                     (if p2
                           (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "_non" (trans p2 0 1))
                           (progn (vl-cmdf ".BREAK" ent "F" "_non" (trans p1 0 1) "@") (redraw (entlast) 3))
                     )
            )
   )
   (mapcar 'eval e_lst)
   (redraw)
   (princ)
)

页: [1]

明经CAD社区's Archiver

SLdesign（三领）Breaks