[求助]谁有快速画出两角度线的平分线的程序？[

东哥

关于角平分线，如果仅仅是为了画角平分线，那是实在没必要的。如果是为了学习编程，或作为某个程序中的一部分用，那么编这个程序也是有可能的。何不把那个不怎么好用的程序贴出来大家分析分析？

龙龙仔

EquSpace.lsp

Shareware by Frank J. Hessler, THP Limited (CompuServe 104230,604)
------------------------------------------------------------------

One of the very first LISP routine I wrote way back for Version 2.6 a
routine to equally space lines between 2 lines.  In my line of business,
structural engineering, I needed a way to equally space lines between 2
other lines (for beams within a bay).  The ARRAY command is what I
needed, but when I had a bay size of 25'-6 7/8", QUICK!! what's 3 equal
spaces of that?  I hated to get out by $5.00 TI when I had a $5,000
Compaq in front of me.  Thus was my introduction into the wonderful
world of AutoLISP.

Over the years, I've modified the routine to accept blocks, polylines,
circles, donuts, as well as equally space lines polarly.

To install this LISP routine, simply copy EQUSPACE.LSP to any directory
which is in the path specified by the ACAD environment variable.
Usually, you would place it in \ACAD\SUPPORT.  I keep all mine in \LISP.
Do whatever you want.

When in the AutoCAD Drawing Editor, type "(load "equspace")" or add it
to your ACAD.LSP file to load automatically.  To execute the routine,
type "ESPACE" at the command prompt.  The routine will ask you to select
2 objects, report the distance (or angle) between them, and then as you
for the number of spaces you wish.  That's all there is to it AND IT'S
FAST!!!

Since this is SHAREWARE, all I ask is that you try it out, and if you
like it, you are MORALLY responsible to send $10 to:

     Frank J. Hessler
     THP Limited
     100 East 8th Street
     Cincinnati, Ohio 45202

When you do, I'll send you the source code, unprotected, for your use
and hacking.  You will also be a REGISTERED USER (kind of makes warm and
fuzzy, doesn't it?) so if I come up with a better routine, I'll send it
to you FREE!

If you have any comments on the use of this routine, drop me a line.
Thank you for considering this routine!

(DEFUN c:espace        (/ qj q@ qq ql q& q1 q#        q0 q$ qo q| q% q?j qjj q@j qqj
                 qlj q&j q1j q#j q0j q$j qoj q|j
                )
  (COMMAND ".undo" "g")
  (SETQ q|j (GETVAR "limcheck"))
  (SETVAR "limcheck" 0)
  (WHILE (NULL (SETQ qj (ENTSEL "\nSelect an entity: "))))
  (WHILE (NULL
           (SETQ q@ (ENTSEL "\nSelect next entity Counterclockwise: "))
         )
  )
  (SETQ        qq (ENTGET (CAR qj))
        ql (ENTGET (CAR q@))
  )
  (IF (AND (= (q%j 0 qq) "LINE") (= (q%j 0 ql) "LINE"))
    (PROGN
      (PRINC "\nLines...")
      (SETQ q$ (q%j 10 qq)
            q| (q%j 11 qq)
            qo (q%j 10 ql)
            q% (q%j 11 ql)
      )
      (IF (NOT (INTERS q$ q| qo q% nil))
        (PROGN (PRINC "arallel...")
               (SETQ q0j T
                     q1j (q?@ q$ q|)
                     q#j (q?@ qo q%)
                     qqj (DISTANCE q1j q#j)
               )
               (PRINC (STRCAT "\nDistance is "
                              (RTOS qqj)
                              " / "
                              (RTOS qqj 2 2)
                              ". "
                      )
               )
        )
        (PROGN
          (PRINC "Not parallel...")
          (SETQ        q0j nil
                qoj (INTERS q$ q| qo q% nil)
                qjj (ANGLE qoj (q?@ q$ q|))
                qlj (ANGLE qoj (q?@ qo q%))
                q&j (+ (qj@ 180) (- (qj@ 180) (- qjj qlj)))
          )
          (PRINC (STRCAT "\nAngle is " (ANGTOS q&j 0 2) " degrees. "))
        )
      )
    )
    (PROGN (SETQ q0j T)
           (IF (AND (= (q%j 0 qq) "OLYLINE") (= (q%j 0 ql) "OLYLINE"))
             (PROGN (PRINC "\nPolylines...")
                    (SETQ q&  (ENTGET (ENTNEXT (q%j -1 qq)))
                          q1  (ENTGET (ENTNEXT (q%j -1 q&)))
                          q1j (q?@ (q%j 10 q&) (q%j 10 q1))
                          q#  (ENTGET (ENTNEXT (q%j -1 ql)))
                          q0  (ENTGET (ENTNEXT (q%j -1 q#)))
                          q#j (q?@ (q%j 10 q#) (q%j 10 q0))
                    )
             )
             (PROGN (PRINC "\nCircles or blocks...")
                    (SETQ q1j (q%j 10 qq)
                          q#j (q%j 10 ql)
                    )
             )
           )
           (SETQ qqj (DISTANCE q1j q#j))
           (PRINC (STRCAT "\nDistance is "
                          (RTOS qqj)
                          " / "
                          (RTOS qqj 2 2)
                          ". "
                  )
           )
    )
  )
  (COND ((= q@@ nil) (SETQ q@@ 2)))
  (INITGET 6)
  (SETQ q?j (GETINT (STRCAT "\nNumber of spaces <" (ITOA q@@) ">: ")))
  (IF (= q?j nil)
    (SETQ q?j q@@)
    (SETQ q@@ q?j)
  )
  (SETQ qq@ (GETVAR "ucsfollow"))
  (SETVAR "ucsfollow" 0)
  (COMMAND ".ucs" "w")
  (IF q0j
    (PROGN (SETQ q@j (/ qqj q?j))
           (SETVAR "snapang" (ANGLE q1j q#j))
           (COMMAND ".array" qj "" "R" 1 q?j q@j)
           (SETVAR "snapang" 0)
           (PRINC (STRCAT "\nSpaced at "
                          (RTOS q@j 2 2)
                          " inches ("
                          (RTOS q@j)
                          ") on center. "
                  )
           )
    )
    (PROGN (COMMAND ".array" qj "" "" qoj (1+ q?j) (ql@ q&j) "")
           (ENTDEL (ENTLAST))
           (REDRAW (CAR q@))
           (PRINC (STRCAT "Spaced at "
                          (RTOS (/ (ATOF (ANGTOS q&j 0 2)) q@@) 2 2)
                          " degrees on center. "
                  )
           )
    )
  )
  (SETVAR "limcheck" q|j)
  (COMMAND ".ucs" "p")
  (COMMAND ".undo" "e")
  (PRINC)
)
(DEFUN q?@ (q&@ q1@)
  (MAPCAR (QUOTE (LAMBDA (q#@ q0@) (/ (+ q#@ q0@) 2)))
          q&@
          q1@
  )
)
(DEFUN qj@ (q$@) (* PI (/ q$@ 180.0)))
(DEFUN ql@ (q$@) (* (/ q$@ PI) 180.0))
(DEFUN q%j (q$@ qo@) (CDR (ASSOC q$@ qo@)))
(PRINC "\nType ESPACE to run command.")

东哥

刚下载的，大家试试。
——————————————————————————————————; bisect.lsp
;平分角，拾取两条线并从其交点绘制平分线延长至第一个拾取点。
;如果两线平行则中止。

(defun getln (PR)
   (setq TYPE "nil"
   PRMPT (strcat "\n拾取" PR "线： "))
   (while (/= TYPE "LINE")
      (if (/= (setq TEMP (entsel PRMPT)) nil)
         (progn
            (setq LN1 (entget (car TEMP))
            TYPE (cdr (assoc 0 LN1)))
            (if (/= TYPE "LINE")
            (print (strcat "不能截开 " TYPE)))
         )
         (print "Invalid point")
      )
   ) ;end while
) ;end getln()

(defun C:BISECT(/ P1 P2 P3 P4 PIK1 PIK2 LN1 P5 P6 ANGA ANGB ANGC TEMP TYPE)
   (getln "第一条")
   (setq P1 (cdr (assoc 10 LN1))
      P2 (cdr (assoc 11 LN1))
      PIK1 (osnap (cadr TEMP) "near")
   )
   (getln "第二条")
   (setq p3 (cdr (assoc 10 LN1))
      P4 (cdr (assoc 11 LN1))
      PIK2 (osnap (cadr TEMP) "near")
   )
   ; 取交点和角度
   (setq P5 (inters P1 P2 P3 P4 nil)
      ANGA (angle P5 PIK1)
      ANGB (angle P5 PIK2)
   )
   (if (> ANGA ANGB)
      (setq ANGC (+ (/ (+ (- (* 2 pi) ANGA) ANGB) 2) ANGA))
      (setq ANGC (+ (/ (- ANGB ANGA) 2) ANGA))
   )
   ; 从交点绘制平分线到一定长度
   (command "LINE" P5 (polar P5 ANGC (distance P5 PIK1)) "")      
   (prin1)
); end bisect.lsp