[编程交流] 无尽的中心线

; pipe offset for different size pipes
; by Alan H July 2014
(vl-load-com)
(defun trap (errmsg)
 (prompt "\nAn error has occured.")
 (setvar "osmode" oldsnap)
 (setq *error* temperr)
)
(setq temperr *error*)
(setq *error* trap)
(setq  doc (vla-get-activedocument (vlax-get-acad-object))) ; open database
(defun loadLinetype (doc LineTypeName FileName)
 (if (and
       (not (existLinetype doc LineTypeName))
       (vl-catch-all-error-p
         (vl-catch-all-apply
           'vla-load
           (list
             (vla-get-Linetypes doc)
             LineTypeName
             FileName
           )
         )
       )
     )
   nil
   T
 )
)
(defun existLinetype (doc LineTypeName / item loaded)
 (vlax-for item (vla-get-linetypes doc)
   (if (= (strcase (vla-get-name item)) (strcase LineTypeName))
     (setq loaded T)
   )
 )
)
;load missing linetypes
;;; returns: T if loaded else nil
;(loadLinetype doc "EX_PIPE250" "custom.lin")
(defun pipeoffset (w / ang stpt pt3 pt4 obj whatis)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq temperr *error*)
(setq *error* trap)
(setq obj (entsel "\nPick line"))
(setq objtype (vla-get-objectname (vlax-ename->vla-object (car obj))))
(if (= "AcDbLINE" objtype)
 (progn
    (alert "You have picked an object which is not a line\nTry Again")
    (exit)
 )
 (princ "\nLine")
)
(setq stpt (assoc 10 (entget (car obj))))
(setq stpt (list (nth 1 stpt)(nth 2 stpt)))
(setq endpt (assoc 11 (entget (car obj))))
(setq endpt (list (nth 1 endpt)(nth 2 endpt)))
(setq ang (angle stpt endpt))
(setq pt3 (polar stpt (+ ang (/ pi 2.0)) 1.0))
(setq pt4 (polar stpt (- ang (/ pi 2.0)) 1.0))
(command "offset" w obj pt3 "")
;(Command "chprop" "last" "" "LT" "EX_PIPE250" "")
(command "offset" w obj pt4 "")
;(Command "chprop" "last" "" "LT" "EX_PIPE250" "")
;(command "Erase" obj "")
(setvar "osmode" oldsnap)
)
(defun c:P100 ()
(pipeoffset 0.06)
)
(defun c:P150 ()
(pipeoffset 0.08)
)
(defun c:P225 ()
(pipeoffset 0.152)
)
(defun c:P300 ()
(pipeoffset 0.19)
)
(defun c:P375 ()
(pipeoffset 0.228)
)
(defun c:P450 ()
(pipeoffset 0.265)
)
(defun c:P525 ()
(pipeoffset 0.302)
)
(defun c:P600 ()
(pipeoffset 0.34)
)
(defun c:P675 ()
(pipeoffset 0.34)
)
(defun c:P750 ()
(pipeoffset 0.415)
)
(defun c:P825 ()
(pipeoffset 0.455)
)
(defun c:P900 ()
(pipeoffset 0.49)
)
(defun c:P975 ()
(pipeoffset 0.528)
)
(defun c:P1050 ()
(pipeoffset 0.565)
)
(defun c:P1125 ()
(pipeoffset 0.6)
)
(defun c:P1200 ()
(pipeoffset 0.64)
)
(setq *error* temperr)
(princ)

(defun c:cPoly (/ ent1 ent2 i len pt p1 ptlst)
 (vl-load-com)
 (if (and (setq ent1 (car (entsel "\nSelect First Polyline: ")))
          (wcmatch (cdr (assoc 0 (entget ent1))) "*POLYLINE")
          (setq ent2 (car (entsel "\nSelect Second Polyline: ")))
          (wcmatch (cdr (assoc 0 (entget ent2))) "*POLYLINE"))
   (progn
     (setq i -1 len (/ (vla-get-Length
                         (vlax-ename->vla-object ent1)) 100.))
     
     (while (setq pt (vlax-curve-getPointatDist ent1 (* (setq i (1+ i)) len)))
       (setq p1    (vlax-curve-getClosestPointto ent2 pt t)
             ptlst (cons (polar pt (angle pt p1) (/ (distance pt p1) 2.)) ptlst)))
     
     (setq ptlst (apply (function append)
                        (mapcar
                          (function
                            (lambda (x) (list (car x) (cadr x)))) ptlst)))
     
     (vla-AddLightWeightPolyline
       (vla-get-ModelSpace
         (vla-get-ActiveDocument (vlax-get-acad-object)))
       (variant
         (vlax-safearray-fill
           (safearray vlax-VBDouble (cons 0 (1- (length ptlst)))) ptlst)))))
 (princ))