帮助修改现有lisp

dnovember99 · 发表于 2022-7-5 15:46:42

大家好，

（抱歉，如果这是长的）我发现了一个Lisp程序，我认为它的工作方式本身绝对令人惊讶。我想知道是否有人能帮我修改一下。我试过了，但我的英语被电脑听不懂！

这是一个break-all-lisp（见下文），它最初是由李·麦克唐纳在2009年创建的。（非常感谢。）
我所说的一切都是二维的。
我想知道是否有一种方法可以修改它，使其具有特定的层（例如：冷水、热水等）可以给定一个值，以表示“只要a层和B层交叉，B层就会以特定的距离断开（我通常在线路的任一侧做3”），以表明B层比a层“低”

我知道2D没有高度。我正在做的项目有很多管道交叉，我希望能够加快速度。现在我一次只能做一个十字路口。下面是我使用的管道列表（我在这些（）中放的只是希望管道是这样的，认为这可能有助于为其他管道提供价值。）

PNDCW（冷水）
PNDHW（热水）
PNHWR（热水回水）
PNDCW RO（RO水）
PNDCW ROR（再矿化反渗透水）
PNDCW RO-B（地板下的RO水）
PNDCW ROR-B（地板下的再矿化反渗透水）
PNGWB（油脂废料）
PNSNB（油脂废料）
PNVNT（通风）
VBF-管道（地板下方的通风口）
这是我开始用的Lisp程序。

copy

;;; Break All, by Lee McDonnell.  25/07/2009
(defun c:brkAll (/ *error* doc spc ss Objlst Obj iLst Altlst lst)
 (vl-load-com)
 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ
       (strcat "\n** Error: " msg " **")))
   (princ))
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 
 (vla-StartUndoMark doc)
 (or *brk$dis* (setq *brk$dis* 5.))
 (if (setq ss (ssget '((0 . "*LINE,ARC"))))
   (progn
     (or (not
           (setq tmp
             (getdist
               (strcat "\nSpecify Break Distance <" (rtos *brk$dis* 2 2) "> : "))))
         (setq *brk$dis* tmp))
     (setq Objlst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (while (setq Obj (car Objlst))
       (foreach iObj (setq Objlst (cdr Objlst))
         (setq iLst
           (cons
             (cons Obj
               (vlax-list->3D-point
                 (vlax-invoke Obj
                   'IntersectWith iObj acExtendNone))) iLst))))
     (mapcar 'setvar vl '(0 0))
     (foreach Int (vl-remove-if-not
                    (function
                      (lambda (x)
                        (vl-consp (cdr x)))) iLst)
       (setq Obj (car Int))
       (foreach Pt (cdr Int)
         (and Altlst (setq lst Altlst))
         (if (not (setq bDis (vlax-curve-getDistatPoint Obj Pt)))
           (while (and (not bDis) lst)
             (setq bDis (vlax-curve-getDistatPoint (setq Obj (car lst)) Pt)
                   lst (cdr lst))))
         (if bDis
           (progn
             (or (setq bPt1 (vlax-curve-getPointatDist Obj
                              (+ bDis (/ *brk$dis* 2.))))
                 (setq bPt1 (vlax-curve-getEndPoint Obj)))
             (or (setq bPt2 (vlax-curve-getPointatDist Obj
                              (- bDis (/ *brk$dis* 2.))))
                 (setq bPt2 (vlax-curve-getStartPoint Obj)))
             (command "_.Break"
               (list (vlax-vla-object->ename Obj) pt) "_F" bPt1 bPt2)
             (setq AltLst (cons (vlax-ename->vla-object (entlast)) AltLst)))))))
   (princ "\n** Nothing Selected **"))
 (vla-EndUndoMark doc)
 (mapcar 'setvar vl ov)
 (princ))
             
(defun vlax-list->3D-point (lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
         (vlax-list->3D-point (cdddr lst)))))