[转贴]：Reverse Pline

eachy · 发表于 2005-10-6 19:17:04

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

; =============================================================================
; Filename : RevPlines.lsp
; Datum : 28.09.05
; Author : jme
; Copyright : MENZI ENGINEERING GmbH, Switzerland
; Revision 1 : __.__.__ ___ -
; -----------------------------------------------------------------------------
; Description:
; Program to reverse the vertex order of Polylines.
; -----------------------------------------------------------------------------
; Global variables:
;
; -----------------------------------------------------------------------------
; Internal LISP-functions:
; MeDoubleUp MeRevPline MeSelPline MeTripleUp
; -----------------------------------------------------------------------------
; External LISP-functions:
; None
; -----------------------------------------------------------------------------
; Version notes:
; AutoCAD: Version: Language: AddIns:
; 15 up 1.00 English ...
; -----------------------------------------------------------------------------
;
; == Message on loading =======================================================
;
(princ "\nRevPlines v1.00")
;
; == Main =====================================================================
;
(defun C:RevPlines ( / AcaDoc CurObj)
(if (< (atof (getvar "ACADVER")) 15.0)
(alert " RevPlines requires AutoCAD 2000 or higher. ")
(progn
(vl-load-com)
(setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq CurObj (MeSelPline "\nSelect Polyline <exit>: "))
(progn
(vla-StartUndoMark AcaDoc)
(MeRevPline CurObj)
(vla-EndUndoMark AcaDoc)
)
)
)
)
(princ)
)
;
; == Sub function library =====================================================
;
; == Function MeDoubleUp
; Converts a list to an double point list.
; Arguments [Type]:
; Lst = List to convert, eg. '(1 2 3 4 5 6) [LIST]
; Return [Type]:
; > Coverted list '((1 2)(3 4)(5 6)) [LIST]
; Notes:
; Credits to Ken Alexander
;
(defun MeDoubleUp (Lst / RetLst TmpLst)
(if (setq TmpLst Lst)
(while
(setq RetLst (cons (list (car TmpLst) (cadr TmpLst)) RetLst)
TmpLst (cddr TmpLst)
)
)
)
(reverse RetLst)
)
;
; == Function MeRevPline
; Reverses the vertices of a polyline.
; Arguments [Typ]:
; Obj = Pline-Object [VLA-OBJECT]
; Return [Typ]:
; > Pline-object reversed [VLA-OBJECT]
; Notes:
; None
;
(defun MeRevPline (Obj / BlgLst NewCor ObjNme OldCor SegCnt Ubound)
(setq ObjNme (vla-get-ObjectName Obj)
OldCor (if (eq ObjNme "AcDbPolyline")
(MeDoubleUp (vlax-get Obj 'Coordinates))
(MeTripleUp (vlax-get Obj 'Coordinates))
)
NewCor (apply 'append (reverse OldCor))
)
(vlax-put Obj 'Coordinates NewCor)
(if (not (eq ObjNme "AcDb3dPolyline"))
(progn
(setq Ubound (1- (length OldCor))
BlgLst (list (* (vla-GetBulge Obj Ubound) -1))
SegCnt 0
)
(repeat Ubound
(setq BlgLst (cons (* (vla-GetBulge Obj SegCnt) -1) BlgLst)
SegCnt (1+ SegCnt)
)
)
(setq SegCnt 0)
(foreach memb BlgLst
(vla-SetBulge Obj SegCnt memb)
(setq SegCnt (1+ SegCnt))
)
)
)
(vla-Update Obj)
Obj
)
;
; -- Function MeSelPline
; Extended entsel for Plines.
; Arguments [Type]:
; Pmt = Prompt [STR]
; Return [Type]:
; > Selected Pline object [VLA-OBJECT]
; > False if user press 'Enter'
; Notes:
; None
;
(defun MeSelPline (Pmt / CurEnt CurObj ExLoop NmeLst)
(setq NmeLst '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline"))
(while (not ExLoop)
(initget " ")
(setq CurEnt (entsel Pmt))
(cond
((= CurEnt "") (setq ExLoop T CurObj nil))
(CurEnt
(setq CurObj (vlax-ename->vla-object (car CurEnt)))
(if (not (vl-position (vla-get-ObjectName CurObj) NmeLst))
(princ "selected entity is not a *Polyline. ")
(setq ExLoop T)
)
)
((princ "1 selected, 0 found"))
)
)
CurObj
)
;
; == Function MeTripleUp
; Converts a list to an double point list.
; Arguments [Type]:
; Lst = List to convert, eg. '(1 2 3 4 5 6) [LIST]
; Return [Type]:
; > Coverted list '((1 2 3) (4 5 6)) [LIST]
; Notes:
; Credits to Ken Alexander
;
(defun MeTripleUp (Lst / RetLst TmpLst)
(if (setq TmpLst Lst)
(while
(setq RetLst (cons (list (car TmpLst) (cadr TmpLst) (caddr TmpLst)) RetLst)
TmpLst (cdddr TmpLst)
)
)
)
(reverse RetLst)
)
;
; == Copyright - Note (May be never deleted) ==================================
;
(princ "\n-------------------------------------------")
(princ "\n ?005 MENZI ENGINEERING GmbH, Switzerland ")
(princ "\n-------------------------------------------")
(princ "\nType RevPlines in the command line to start the programm...")
(princ)
;
; == End RevPlines ============================================================

; ============================================================================= 
; Filename    :   RevPlines.lsp 
; Datum       :   28.09.05 
; Author      :   jme 
; Copyright   :   MENZI ENGINEERING GmbH, Switzerland 
; Revision  1 :   __.__.__ ___ - 
; ----------------------------------------------------------------------------- 
; Description: 
; Program to reverse the vertex order of Polylines. 
; ----------------------------------------------------------------------------- 
; Global variables: 
; 
; ----------------------------------------------------------------------------- 
; Internal LISP-functions: 
; MeDoubleUp MeRevPline MeSelPline MeTripleUp 
; ----------------------------------------------------------------------------- 
; External LISP-functions: 
; None 
; ----------------------------------------------------------------------------- 
; Version notes: 
; AutoCAD:        Version:        Language:        AddIns: 
; 15 up                1.00                English                ... 
; ----------------------------------------------------------------------------- 
; 
; == Message on loading ======================================================= 
; 
(princ "\nRevPlines v1.00") 
; 
; == Main ===================================================================== 
; 
(defun C:RevPlines ( / AcaDoc CurObj) 
 (if (< (atof (getvar "ACADVER")) 15.0) 
  (alert " RevPlines requires AutoCAD 2000 or higher. ") 
  (progn 
   (vl-load-com) 
   (setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))) 
   (if (setq CurObj (MeSelPline "\nSelect Polyline <exit>: ")) 
    (progn 
     (vla-StartUndoMark AcaDoc) 
     (MeRevPline CurObj) 
     (vla-EndUndoMark AcaDoc) 
    ) 
   ) 
  ) 
 ) 
 (princ) 
) 
; 
; == Sub function library ===================================================== 
; 
; == Function MeDoubleUp 
; Converts a list to an double point list. 
; Arguments [Type]: 
;   Lst = List to convert, eg. '(1 2 3 4 5 6) [LIST] 
; Return [Type]: 
;   > Coverted list '((1 2)(3 4)(5 6)) [LIST] 
; Notes: 
;   Credits to Ken Alexander 
; 
(defun MeDoubleUp (Lst / RetLst TmpLst) 
 (if (setq TmpLst Lst) 
  (while 
   (setq RetLst (cons (list (car TmpLst) (cadr TmpLst)) RetLst) 
         TmpLst (cddr TmpLst) 
   ) 
  ) 
 ) 
 (reverse RetLst) 
) 
; 
; == Function MeRevPline 
; Reverses the vertices of a polyline. 
; Arguments [Typ]: 
;   Obj = Pline-Object [VLA-OBJECT] 
; Return [Typ]: 
;   > Pline-object reversed [VLA-OBJECT] 
; Notes: 
;   None 
; 
(defun MeRevPline (Obj / BlgLst NewCor ObjNme OldCor SegCnt Ubound) 
 (setq ObjNme (vla-get-ObjectName Obj) 
       OldCor (if (eq ObjNme "AcDbPolyline") 
               (MeDoubleUp (vlax-get Obj 'Coordinates)) 
               (MeTripleUp (vlax-get Obj 'Coordinates)) 
              ) 
       NewCor (apply 'append (reverse OldCor)) 
 ) 
 (vlax-put Obj 'Coordinates NewCor) 
 (if (not (eq ObjNme "AcDb3dPolyline")) 
  (progn 
   (setq Ubound (1- (length OldCor)) 
         BlgLst (list (* (vla-GetBulge Obj Ubound) -1)) 
         SegCnt 0 
   ) 
   (repeat Ubound 
    (setq BlgLst (cons (* (vla-GetBulge Obj SegCnt) -1) BlgLst) 
          SegCnt (1+ SegCnt) 
    ) 
   ) 
   (setq SegCnt 0) 
   (foreach memb BlgLst 
    (vla-SetBulge Obj SegCnt memb) 
    (setq SegCnt (1+ SegCnt)) 
   ) 
  ) 
 ) 
 (vla-Update Obj) 
 Obj 
) 
; 
; -- Function MeSelPline 
; Extended entsel for Plines. 
; Arguments [Type]: 
;   Pmt = Prompt [STR] 
; Return [Type]: 
;   > Selected Pline object [VLA-OBJECT] 
;   > False if user press 'Enter' 
; Notes: 
;   None 
; 
(defun MeSelPline (Pmt / CurEnt CurObj ExLoop NmeLst) 
 (setq NmeLst '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")) 
 (while (not ExLoop) 
  (initget " ") 
  (setq CurEnt (entsel Pmt)) 
  (cond 
   ((= CurEnt "") (setq ExLoop T CurObj nil)) 
   (CurEnt 
    (setq CurObj (vlax-ename->vla-object (car CurEnt))) 
    (if (not (vl-position (vla-get-ObjectName CurObj) NmeLst)) 
     (princ "selected entity is not a *Polyline. ") 
     (setq ExLoop T) 
    ) 
   ) 
   ((princ "1 selected, 0 found")) 
  ) 
 ) 
 CurObj 
) 
; 
; == Function MeTripleUp 
; Converts a list to an double point list. 
; Arguments [Type]: 
;   Lst = List to convert, eg. '(1 2 3 4 5 6) [LIST] 
; Return [Type]: 
;   > Coverted list '((1 2 3) (4 5 6)) [LIST] 
; Notes: 
;   Credits to Ken Alexander 
; 
(defun MeTripleUp (Lst / RetLst TmpLst) 
 (if (setq TmpLst Lst) 
  (while 
   (setq RetLst (cons (list (car TmpLst) (cadr TmpLst) (caddr TmpLst)) RetLst) 
         TmpLst (cdddr TmpLst) 
   ) 
  ) 
 ) 
 (reverse RetLst) 
) 
; 
; == Copyright - Note (May be never deleted) ================================== 
; 
(princ "\n-------------------------------------------") 
(princ "\n ?005 MENZI ENGINEERING GmbH, Switzerland ") 
(princ "\n-------------------------------------------") 
(princ "\nType RevPlines in the command line to start the programm...") 
(princ) 
; 
; == End RevPlines ============================================================

fengjianwei · 发表于 2006-11-14 09:34:16

该程序不能处理光滑过的多义线

ilovetank · 发表于 2007-1-20 10:09:56

楼主能不能解释以下，看不懂啊。

账号		自动登录	找回密码
密码			立即注册

[转贴]：Reverse Pline

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子