[LISP程序]：大家看看如何实现自动标注

linhui12

看看在下想在此基础上添加对绘制出的L线和PL线进行自动标注(标注线距离该线20),请大家相助.
;绘制双线管程序 by sailorcwx @2008.5.22
(defun drawpipers (DstDW   DstR    AngN    cpts    /    ACADAPP
     ACADDOC ACADSPC ANG    ANGSME  EPT    LASTPT
     OSM    PIPT1   PIPT2   PIPT3   PIPT4   PLPTS
     PTA    PTA1    SPT
    )
  (vl-load-com)
  (setq Acadapp (vlax-get-acad-object)
Acaddoc (vla-get-activedocument Acadapp)
  )
  (if (= (getvar "TILEMODE") 1)
    (setq Acadspc (vla-get-modelspace Acaddoc))
    (setq Acadspc (vla-get-paperspace Acaddoc))
  )
  (setq osm (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (>= (length cpts) 3)
    (progn
      (setq lastpt (DrawWinding cpts DstR DstDW AngN ACADSPC)
     pta    (nth 0 cpts)
      )
      (setq ang (angle (nth 0 cpts) (nth 1 cpts)))
      (vla-addline
Acadspc
(vlax-3d-point (polar pta (+ ang (/ pi 2)) DstDW))
(vlax-3d-point (polar pta (- ang (/ pi 2)) DstDW))
      )
      (setq pta1 (last cpts)
     ang  (angle lastpt (last cpts))
      )
      (vla-addline
Acadspc
(vlax-3d-point (polar lastpt (+ ang (/ pi 2)) DstDW))
(vlax-3d-point (polar pta1 (+ ang (/ pi 2)) DstDW))
      )
      (vla-addline
Acadspc
(vlax-3d-point (polar lastpt (- ang (/ pi 2)) DstDW))
(vlax-3d-point (polar pta1 (- ang (/ pi 2)) DstDW))
      )
      (vla-addline
Acadspc
(vlax-3d-point (polar pta1 (+ ang (/ pi 2)) DstDW))
(vlax-3d-point (polar pta1 (- ang (/ pi 2)) DstDW))
      )
    )
    (progn
      (setq Spt    (car cpts)
     Ept    (cadr cpts)
     AngSME (angle Spt Ept)
     PiPt1  (polar Spt (+ AngSME (/ pi 2)) DstDW)
     PiPt2  (polar Ept (+ AngSME (/ pi 2)) DstDW)
     PiPt3  (polar Ept (- AngSME (/ pi 2)) DstDW)
     PiPt4  (polar Spt (- AngSME (/ pi 2)) DstDW)
     PlPts  (vlax-make-safearray vlax-vbdouble '(0 . 14))
      )
      (vlax-safearray-fill
PlPts
(append PiPt1 PiPt2 PiPt3 PiPt4 PiPt1)
      )
      (vla-addpolyline Acadspc PlPts)
    )
  )
  (setvar "OSMODE" osm)
)

(defun DrawWinding (cpts    DstR    DstDW   AngN    ACADSPC /
      AngSME  PIPT1   PIPT2   PIPT3   PIPT4   i
      SPT     EPT     ANGBS   ANGEM   ANGSM   ANGSTEP
      CPT     EPT1    EPT2    HEPT    HSPT    INDEX
      MPT     PTLST1  PTLST2  PTLST3  PTLST4  PTLST5
      R1     R2     R3     SPT1    SPT2
     )
  (setq Spt (nth 0 cpts)
Mpt (nth 1 cpts)
Ept (nth 2 cpts)
AngSM (angle Spt Mpt)
AngEM (angle Ept Mpt)
AngSME (abs (- AngSM AngEM))
Angstep (/ (- pi AngSME) AngN)
  )
  (if (or (= (rem AngSME pi) 0) (= Spt Mpt) (= Ept Mpt))
    (progn
      (setq PiPt1 (polar Spt (+ AngSME (/ pi 2)) DstDW)
     PiPt2 (polar Ept (+ AngSME (/ pi 2)) DstDW)
     PiPt3 (polar Ept (- AngSME (/ pi 2)) DstDW)
     PiPt4 (polar Spt (- AngSME (/ pi 2)) DstDW)
     PlPts (vlax-make-safearray vlax-vbdouble '(0 . 11))
      )
      (vlax-safearray-fill PlPts (append PiPt1 PiPt2 PiPt3 PiPt4))
      (vla-addpolyline Acadspc PlPts)
      (setq cpts (cons Ept (cddr cpts)))
      (if (>= (length cpts) 3)
(DrawWinding cpts DstR DstDW AngN ACADSPC)
Ept
      )
    )
    (progn
      (setq R1   (/ (- DstR DstDW) (cos (/ Angstep 2)))
     R2   (/ DstR (cos (/ Angstep 2)))
     R3   (/ (+ DstR DstDW) (cos (/ Angstep 2)))
     HsPt  (inters EPt (polar EPt (+ AngSM (/ pi 2)) 1) MPt SPt nil)
     HePt  (inters SPt (polar SPt (+ AngEM (/ pi 2)) 1) MPt EPt nil)
     SPt1  (polar HsPt (angle HsPt EPt) DstR)
     SPt2  (polar SPt1 AngSM 1)
     EPt1  (polar HePt (angle HePt SPt) DstR)
     EPt2  (polar EPt1 AngEM 1)
     CPt   (inters SPt1 SPt2 EPt1 EPt2 nil)
     Angbs (angle Cpt Mpt)
     index 0
      )
      (if (= (rem AngN 2) 0)
(setq i 0.5
       Ptlst1 '()
       Ptlst2 '()
       Ptlst3 '()
)
(setq i      1
       Ptlst1 (list (polar Cpt Angbs R1))
       Ptlst2 (list (polar Cpt Angbs R2))
       Ptlst3 (list (polar Cpt Angbs R3))
)
      )
      (repeat (/ AngN 2)
(setq Ptlst1 (cons (polar Cpt (+ Angbs (* (+ index i) AngStep)) R1)
      Ptlst1
       )
       Ptlst1 (append
         Ptlst1
         (list (polar Cpt (- Angbs (* (+ index i) AngStep)) R1)
         )
       )
       Ptlst2 (cons (polar Cpt (+ Angbs (* (+ index i) AngStep)) R2)
      Ptlst2
       )
       Ptlst2 (append
         Ptlst2
         (list (polar Cpt (- Angbs (* (+ index i) AngStep)) R2)
         )
       )
       Ptlst3 (cons (polar Cpt (+ Angbs (* (+ index i) AngStep)) R3)
      Ptlst3
       )
       Ptlst3 (append
         Ptlst3
         (list (polar Cpt (- Angbs (* (+ index i) AngStep)) R3)
         )
       )
       index  (1+ index)
)
      )
      (setq Ptlst1 (cons (polar Cpt
    (+ Angbs (* 0.5 AngN AngStep))
    (- DstR DstDW)
    )
    Ptlst1
     )
     Ptlst1 (append Ptlst1
      (list (polar Cpt
     (- Angbs (* 0.5 AngN AngStep))
     (- DstR DstDW)
     )
      )
     )
     Ptlst2 (cons (polar Cpt (+ Angbs (* 0.5 AngN AngStep)) DstR)
    Ptlst2
     )
     Ptlst2 (append
       Ptlst2
       (list (polar Cpt (- Angbs (* 0.5 AngN AngStep)) DstR))
     )
     Ptlst3 (cons (polar Cpt
    (+ Angbs (* 0.5 AngN AngStep))
    (+ DstR DstDW)
    )
    Ptlst3
     )
     Ptlst3 (append Ptlst3
      (list (polar Cpt
     (- Angbs (* 0.5 AngN AngStep))
     (+ DstR DstDW)
     )
      )
     )
     ptlst4 (list (polar CPt (angle Ept Hspt) (- DstR DstDW))
    (polar SPt (angle HsPt EPt) DstDW)
     )
     ptlst5 (list (polar SPt (angle EPt HsPt) DstDW)
    (polar CPt (angle EPt HsPt) (+ DstR DstDW))
     )
      )
      (mapcar '(lambda (Spoint Epoint)
   (vla-addline
     Acadspc
     (vlax-3d-point Spoint)
     (vlax-3d-point Epoint)
   )
        )
       Ptlst1
       Ptlst3
      )
      (mapcar '(lambda (Ptlist / PlPts)
   (setq PlPts (vlax-make-safearray
          vlax-vbdouble
          (cons 0 (- (* 3 (length Ptlist)) 1))
        )
   )
   (vlax-safearray-fill PlPts (apply 'append Ptlist))
   (vla-addpolyline Acadspc PlPts)
        )
       (list Ptlst1 Ptlst2 Ptlst3 Ptlst4 Ptlst5)
      )
      (setq cpts (cons (polar CPt (angle SPt HePt) DstR) (cddr cpts)))
      (if (>= (length cpts) 3)
(DrawWinding cpts DstR DstDW AngN ACADSPC)
(polar CPt (angle SPt HePt) DstR)
      )
    )
  )
)