[编程交流] 在多行中插入PI

(defun c:insertmlinepi (/        *insertmlinepians*
  ent        mlinepts       plinepts
  oldcmlscale    oldclayer      *error*
        )
 (defun *error* (msg)
   (if oldcmlscale
     (setvar 'cmlscale oldcmlscale)
   )
   (if oldclayer
     (setvar 'clayer oldclayer)
   )
   (if (not
  (member msg '("Function cancelled" "quit / exit abort"))
)
     (princ (strcat "\nError: " msg))
   )
   (princ)
 )
 (insertmlinepi:settings)
 (if (and (setq ent (car (entsel "\nSelect MLINE: ")))
   (= (cdr (assoc 0 (entget ent))) "MLINE")
     )
   (progn
     (setq mlinevla (vlax-ename->vla-object ent))
     (setq mlinescale (vlax-get mlinevla 'MLineScale)
    mlinelayer (vlax-get mlinevla 'Layer)
     )
     (setq
mlinepts (mapcar 'cdr
   (vl-remove-if-not
     (function (lambda (pt) (= (car pt) 10)))
     (entget ent)
   )
  )
     )
     (setq oldcmljust (getvar 'cmljust))
     (setvar 'cmljust mlinescale)
     (setq oldclayer (getvar 'clayer))
     (setvar 'clayer mlinelayer)
     (command "._PLINE" (mapcar 'command pts))
     (setq plinelast (entlast))
     (if (= *insertmlinepians* "Insert")
(progn
  (command "._INSERTFEATUREPI" plinelast)
  (while (> (logand (getvar "CMDACTIVE") 1) 0)
    (command PAUSE)
  )
)
(progn
  (command "._DELETEFEATUREPI" plinelast)
  (while (> (logand (getvar "CMDACTIVE") 1) 0)
    (command PAUSE)
  )
)
     )
     (setq
plinepts (mapcar 'cdr
   (vl-remove-if-not
     (function (lambda (pt) (= (car pt) 10)))
     (entget plinelast)
   )
  )
     )
     (command "._mline" (foreach pt pts (command pt)))
     (setvar 'cmlscale oldcmlscale)
     (setvar 'clayer oldclayer)
   )
 )
 (princ)
)
;;;This is the settins portion of the code
(defun insertmlinepi:settings ()
 (initget "Insert Delete")
 (setq *insertmlinepians*
 (cond
   ((getkword
      "\nDo you want to [insert/Delete] PI <Insert>: "
    )
   )
   ("Insert")
 )
 )
)

(while (command "._INSERTFEATUREPI" obj PAUSE)
   (setq obj (entlast))
   (if mobj
     (command "._erase" mobj)
     )
    (setq pts (mapcar 'cdr
  (vl-remove-if-not
    (function (lambda (pt) (= (car pt) 10)))
    (entget obj)
  )
 )
     )
   (command "._mline" (foreach pt pts (command pt)))
   (setq mobj (entlast))
   )

(setq entlist (entget ent))
     (setq mlinepts (assoc 11 entlist))
     (command "._PLINE" (mapcar 'command mlinepts))

  (setq
mlinepts (mapcar 'cdr
   (vl-remove-if-not
     (function (lambda (pt) (= (car pt) [color="red"][b]11[/b][/color])))
     (entget ent)
   )