多线到多线示例:
- (defun c:m2p ( / *error* EntNext_to_End DOC ELST ENT I MSS OV SS UFLAG VL )
- ;; MLine to PLine ~ Lee Mac ~ 04.01.10
- (defun *error* ( msg )
- (and ov (mapcar (function setvar) vl ov))
- (and uflag (vla-EndUndoMark doc))
- (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
- (princ (strcat "\n** Error: " msg " **")))
- (princ)
- )
- (defun EntNext_to_End (ent / a)
- (if (setq ent (entnext ent))
- (cons ent (EntNext_to_End ent))
- )
- )
- (setq vl '("CMDECHO" "PEDITACCEPT" "QAFLAGS")
- ov (mapcar (function getvar) vl) ss (ssadd))
- (mapcar (function setvar) vl '(0 1 0))
- (if (setq i -1 mss (ssget "_:L" '((0 . "MLINE"))))
- (progn
- (setq uFlag
- (not
- (vla-StartUndoMark
- (setq doc
- (vla-get-ActiveDocument
- (vlax-get-acad-object)
- )
- )
- )
- )
- )
- (
- (lambda ( i )
- (while (setq ent (ssname mss (setq i (1+ i))))
- (setq eLst (entlast) ss (ssadd))
- (vl-cmdf "_.explode" ent)
- (mapcar (function (lambda ( x ) (ssadd x ss)))
- (EntNext_to_End eLst)
- )
- (vl-cmdf "_.pedit" "_M" ss "" "_J" "" "")
- (setq ss nil)
- )
- )
- -1
- )
- (setq uFlag (vla-EndUndoMark doc))
- )
- )
- (mapcar (function setvar) vl ov)
- (princ)
- )
|