[编程交流] 偏移三维多段线

; Offset a 3dPoly with horizontal and vertical distances
; 15 August 2014 - Gian Paolo Cattaneo
(defun c:o3 ( / *error* 3dp p ogt)
   (defun *error* ( msg )
       (setvar 'offsetgaptype ogt)
       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))        
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
   (setq ogt (getvar 'offsetgaptype))
   (setvar 'offsetgaptype 0)
   (or op (setq op 0.00))
   (or oz (setq oz 0.00))
   (while
       (progn
           (setq 3dp (car (entsel "\nSelect the 3D polyline to offset")))
           (if (not (eq "AcDb3dPolyline" (vlax-get (vlax-ename->vla-object 3dp) 'ObjectName)))
               (progn
                   (alert "This is not a 3D Polyline")
                   t
               )
           )
       )
   )
   (if 3dp
       (progn
           (while
               (progn
                   (initget (+ 2 4))
                   (setq op
                       (cond
                           ( (getdist (strcat "\nOffset Distance (horizontal)  <" (rtos op 2 2)">: ")) )
                           ( op )
                       )
                   )
                   (if (= op 0.)
                       (progn
                           (alert "The horizontal offset distance must be greater than zero")
                           t
                       )
                   )
               )
           )
           (setq oz
               (cond
                   ( (getdist (strcat "\nOffset Distance (vertical)    <" (rtos oz 2 2)">: ")) )
                   ( oz )
               )
           )
           (setq p (getpoint "\nSpecify point on side to offset "))
           (off3DP 3dp op oz p)
       )
   )
   (setvar 'offsetgaptype ogt)
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (princ)
)
;******************* Offset 3D Polyline ********************;
;                                                           ;
;  obj   [ENAME] - entity name                              ;
;  d_o   [REAL]  - horizontal offset distance               ;
;  d_z   [REAL]  - vertical offset distance                 ;
;  p_of  
[list]  - point on side to offset                  ;
;                                                           ;
; ----------------------------------------------------------;
; (off3DP (car (entsel)) 2.15 -2.00 '(3 4 0))               ;
; ----------------------------------------------------------;
; author: Gian Paolo Cattaneo - 30.03.2013                  ;
;***********************************************************;
(defun off3DP ( obj d_o d_z p_of / EL Lv PL2 PL3 Lv Lv1 Lv2 n_of obj_of)
   (if
       (and
           (eq "AcDb3dPolyline" (vlax-get (vlax-ename->vla-object obj) 'ObjectName))
           (setq Lv (pl_coord obj))
           (setq PL2
               (entmakex
                   (append
                       (list
                           (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 90 (length Lv))
                           (cons 70 (if (vlax-curve-IsClosed obj) 1 0))
                           (cons 43 0.0)
                       )
                       (mapcar '(lambda (x) (cons 10 x)) Lv)
                   )
               )
           )
       )
       (progn
           (setq EL (entlast))
           (vl-cmdf "_offset" d_o PL2 p_of "")
           (if (and
                   (/= EL (setq PL3 (entlast)))
                   (= (setq n_of (length (setq obj_of (e_next EL "LS")))) 1)
               )
               (progn
                   (setq Lv2 nil)
                   (setq Lv1 (pl_coord PL3)) 
                   (entdel PL2)
                   (entdel PL3)    
                   (mapcar
                       '(lambda ( a b )
                            (setq Lv2 (cons (list (car b) (cadr b) (+ d_z (caddr a))) Lv2))
                        )
                        Lv Lv1
                   )
                   (setq Lv2 (reverse Lv2))
                   (entmake
                       (list
                           '(0 . "POLYLINE")
                           '(10 0.0 0.0 0.0)
                           (assoc 8 (entget obj))
                           (assoc 70 (entget obj))
                       )
                   )
                   (repeat (length Lv2)
                       (entmake
                           (list
                               (cons 0 "VERTEX")
                               (cons 10 (CAR Lv2))
                               (cons 70 32)
                           )
                       )
                       (setq Lv2 (cdr Lv2))
                   )
                   (entmake '((0 . "SEQEND")))
                   t
               )
               (progn
                   (entdel PL2)
                   (if (> n_of 1)
                       (repeat n_of
                           (entdel (car obj_of))
                           (setq obj_of (cdr obj_of))
                       )
                   )
                   nil
               )
           )
       )
   )
)
;***********************************************************;
(defun pl_coord (# / p m)
   (setq p (if (vlax-curve-IsClosed #)
               (fix (vlax-curve-getEndParam #))
               (1+ (fix (vlax-curve-getEndParam #)))
           )
   )
   (while (/= 0 p)
       (setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
   )
)
;***********************************************************;
(defun e_next (entL mode / next)
   (if (= mode "SS") (setq next (ssadd)))
   (if (/= entL (entlast))
       (while (setq entL (entnext entL))
           (if (entget entL)
               (cond
                   ( (= mode "LS") (setq next (cons entL next)) )
                   ( (= mode "SS") (setq next (ssadd entL next)) )
               )
           )
       )
   )
   next
)
(vl-load-com)
;***********************************************************;
(prompt "\n ") (prompt "\n ")
(princ "\n\\U+00AB  Offset 3D Polyline - Type "o3" to run  [url="file://\\U+00BB"]\\U+00BB[/url]")
(princ)

(defun c:3doffset-3dpoly ( / ent entA entcoordlst pt3d pt2d entvertlst3d entvertlst2d pto d 2dplo 2dpln 2dplncoordlst 2dplnvertlst3d ptx pty ptz ptxlst ptylst ptzlst 3dplnvertlst3d )
 (setq oscmd (getvar 'osmode))
 (setvar 'osmode 0)
 (setq ent (car (entsel "\nSelect 3D Polyline - 3dpline must not have vertical segments")))
 (vl-load-com)
 (setq entA (vlax-ename->vla-object ent))
 (setq entcoordlst (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates entA))))
 (repeat (/ (length entcoordlst) 3)
   (setq pt3d (list (car entcoordlst) (cadr entcoordlst) (caddr entcoordlst)))
   (setq pt2d (list (car entcoordlst) (cadr entcoordlst) 0 ))
   (repeat 3
     (setq entcoordlst (cdr entcoordlst))
   )
   (setq entvertlst3d (cons pt3d entvertlst3d))
   (setq entvertlst2d (cons pt2d entvertlst2d))
 )
 (setq entvertlst3d (reverse entvertlst3d))
 (setq entvertlst2d (reverse entvertlst2d))
 (command "pline")
 (foreach pt entvertlst2d (command pt)) 
 (command "")
 (command "ucs" "w")
 (command "plan" "")
 (setq pto (getpoint "\nPick point for side for 3doffset (in/out) : "))
 (setq pto (list (car pto) (cadr pto) 0))
 (setq d (getdist "\nInput horizontal distance for 3doffset (2 points) : "))
 (setq 2dplo (entlast))
 (command "offset" d (entlast) pto "")
 (entdel 2dplo)
 (setq 2dpln (entlast))
 (setq 2dplnA (vlax-ename->vla-object 2dpln))
 (setq 2dplncoordlst (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates 2dplnA))))
 (repeat (/ (length 2dplncoordlst) 2)
   (setq pt3d (list (car 2dplncoordlst) (cadr 2dplncoordlst) 0 ))
   (repeat 2
     (setq 2dplncoordlst (cdr 2dplncoordlst))
   )
   (setq 2dplnvertlst3d (cons pt3d 2dplnvertlst3d))
 )
 (setq 2dplnvertlst3d (reverse 2dplnvertlst3d))
 (entdel 2dpln)
 (repeat (length 2dplnvertlst3d)
   (setq ptx (car (car 2dplnvertlst3d)))
   (setq pty (cadr (car 2dplnvertlst3d)))
   (setq 2dplnvertlst3d (cdr 2dplnvertlst3d))
   (setq ptxlst (cons ptx ptxlst))
   (setq ptylst (cons pty ptylst))
 )
 (setq ptxlst (reverse ptxlst))
 (setq ptylst (reverse ptylst))
 (repeat (length entvertlst3d)
   (setq ptz (caddr (car entvertlst3d)))
   (setq entvertlst3d (cdr entvertlst3d))
   (setq ptzlst (cons ptz ptzlst))
 )
 (setq ptzlst (reverse ptzlst))
 (repeat (length ptzlst)
   (setq ptn (list (car ptxlst) (car ptylst) (car ptzlst)))
   (setq ptxlst (cdr ptxlst))
   (setq ptylst (cdr ptylst))
   (setq ptzlst (cdr ptzlst))
   (setq 3dplnvertlst3d (cons ptn 3dplnvertlst3d))
 )
 (setq 3dplnvertlst3d (reverse 3dplnvertlst3d))
 (command "3dpoly")
 (foreach pt 3dplnvertlst3d (command pt)) 
 (command "")
 (setvar 'osmode oscmd)
 (princ)
)