关于角平分线
关于角平分线，如果仅仅是为了画角平分线，那是实在没必要的。如果是为了学习编程，或作为某个程序中的一部分用，那么编这个程序也是有可能的。何不把那个不怎么好用的程序贴出来大家分析分析？两角度线的平分线的程序,这样也要钱!!!!!!
EquSpace.lspShareware 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 "Parallel...")
(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) "POLYLINE") (= (q%j 0 ql) "POLYLINE"))
(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 "" "P" 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
页:
1
[2]