通用函数揭密与改进

summerfly2008

通用函数是以往程序的提炼和总结，使新编程序简洁可读。
以下函数仅供参考，请大家批评指正，能否更高效简洁？任何高见均会被采纳！
: \/ V9 T" L( N0 i) M/ WPHP代码:
5 M% V6 m% f5 K- q* d5 c! N
目录：
7 ^+ x0 r7 f3 w2 t6 `1、cmdla--  序列 位于程序的开始和结束，用于存储和恢复用户的系统变量
/ G! L. o& y5 ]2、sub_upd  更改图元DXF组码以修改实体属性
3、xyp-Sort-Text  文本排序
/ w% c; M$ e- w- V; ~4、xyp-Sort  选择集排序
3 F/ u( n! G) w4 n6 \5、xyp-get-DXF  Dxf组码
; @3 L! J/ y/ @" G+ K6、SETBL  比例设置
7、xyp-get-tblnext  获得特定符号表的列表
+ G- F# t+ @0 m2 ~: D4 M8 J" J8、xyp-DelSame  删除表中的重复元素
9、xyp-Text  定点写字
10、U系列函数
11、xyp-get-MinMaxPoint  指定对象最小外接矩形的九点坐标
12、xyp-get-RightPoint  两点中点之正方向点
13、xyp-ZB  坐标标注函数
4 {2 \' l+ u/ `; d14、XYP-GET-COLOR  取得物体的颜色（含随层）

9 A1 S4 r& ?+ U3 L* n/ H1 x[ 本帖最后由 summerfly2008 于 2006-4-27 10:15 编辑 ]

summerfly2008

一、cmdla－序列
位于程序的开始和结束，用于存储和恢复用户的系统变量……
% e5 H, {+ z8 W3 [4 W! c3 C& H
. O& ^) W  h# l' ~* X代码:

  m2 r9 _3 }( E! E;;;通用子程序                                               
) u7 {$ F: u+ w. _- B7 l;;;------------------------ CMDLA0 -------------------------
# y! W7 Y0 f& v2 v+ }% x3 h2 a5 Y;;;------------------------ CMDLASC0 -----------------------
;;;                    保存用户系统变量                     
;;;方式 : (CMDLA0)
5 S" C% n5 y# P; h& l, `! h(defun CMDLASC0        ()
  Y/ c- x; m* G  (CMDLA0)
" M& ]+ m/ a( a7 E, C  (if (null sc)
    (SETBL)
1 @; t) F$ J: L4 V  )
)
! h6 {- M% Y5 R(defun CMDLA0 ()
  (defun *error* (msg)
9 J! T" q+ c" o4 |    (princ "错误 : ")
6 s0 M5 K9 q! |/ O) B    (princ msg)
$ @0 m7 \" ^' h    (CMDLA1)
6 {3 o* ^, }1 ~7 N% o* o0 r$ C+ f  )
  (SetQ        **SysVarNL**
2 m) l! _- u% b5 p; B+ I5 ]                     '("AUNITS"             "AUPREC"           "ATTDIA"
) X4 H7 ?# c+ |1 J4 k/ R$ |( k                       "BLIPMODE"    "CECOLOR"           "CELTYPE"
                       "CLAYER"             "CMDECHO"           "DIMZIN"
7 i; Y! ^+ T; [% W1 ^) B4 ^                       "EXPERT"             "HIGHLIGHT"   "LUNITS"
7 ], i6 R' |4 X" E! J$ q  D) r: H                       "LUPREC"             "OSMODE"           "ORTHOMODE"
                       "TEXTSTYLE"   "PLINEWID"           "dimdec"
                       "dimadec"     "regenmode"   "pickbox"
                      )
        #time1             (rtos (getvar "cdate") 2 16)
% U/ L2 _5 Y- {8 R/ e7 b7 Y) \        start-time   (substr (rtos (getvar "cdate") 2 16) 7)
  )
  (SetIErr)
& l8 a# ^4 c' G' T9 }; A" T& S  (command "ucs" "")
7 v' g. F: Y: R- [. n$ D" h  (command ".undo" "BE")
  (princ)
4 n' i7 a: G- i)


(Defun SetIErr (/ sv)
, [- R( h6 O& w" H  (If (= 'LIST (Type *error*))
    (Alert "错误：最后一个(SetIErr)函数没有配对的(ReErr)!")
    (Progn
9 c/ U" w7 [$ |) v* E- |6 \3 f      (SetQ **svarl** '())
' n3 Z' j" Y! N+ K0 q) b      (ForEach sv **SysVarNL**
        (SetQ **svarl** (Cons (GetVar sv) **svarl**))
      )
      (ForEach sv '("ATTDIA"           "BLIPMODE"          "CMDECHO"
' e! i6 m2 W2 Q! ^/ E  R# N                    "ORTHOMODE"           "DIMZIN"          "plinewid"
9 W2 g2 a1 G, ]4 {                    "regenmode"
- A5 r8 T. P# _" F9 B4 E                   )
        (SetVar sv 0)
      )
2 w0 y: j  D; K2 i      (setvar "ATTREQ" 1)
" }) e1 v% {. Q8 b      (SetVar "EXPERT" 5)
" Q7 V) s) l- s7 T& x/ l      (setvar "pickbox" 5)
      (setvar "pickadd" 1)
3 i% n' ~  m! X; e, x) m/ ~      (setvar "aperture" 5)
3 I7 s, ^5 I+ g3 E3 O$ X      (Defun-Q *error* (st) (ReErr))
    )
. N# o& e1 H9 z* t! u* V# S5 w. k  )
0 [. I% X1 U5 X5 M4 |. Q)
! Q) }4 k, [5 x0 U  S; z9 L(Defun ReErr ()
  (If (= 'LIST (Type *error*))
    (Progn
      (MapCar 'SetVar **SysVarNL** (Reverse **svarl**))
) Y  e& g9 H! e; g- k, E9 N1 G" {. `      (SetQ *error* nil)
9 `6 q) @) U3 M9 k# k  O      (SetVar "modemacro" ".")
    )
  j9 G5 U. |# c4 b: S  )
)

;;;------------------------ CMDLA1 -------------------------
;;;                     恢复用户系统变量                    
;;;方式 : (CMDLA1)                                          
(defun CMDLA1 ()
  (command ".undo" "E")
  (command "ucs" "")
/ s( B0 C  V  v  (ReErr)
! I1 y7 @. x: F& l  (princ)
)
) Z: ^/ _" T  z7 D% K9 W
$ z9 G( J5 R$ Y- {- U# d" n
+ V) \+ G% |3 I;;; ---------------------- setbl ---------------------------
- s* m9 o& P2 I' t0 m' };;;                    设置出图比例                        
& A+ {2 r8 _1 S2 P& Y;;;方式 : (setbl)
+ Q' h& m; x; B# q(defun setbl ()
  (if (= (getvar "UserI1") 0)
0 t- Z3 ~  q+ ^3 Q    (setvar "UserI1" 1)
1 M% V& S7 ]5 I2 t  )
  (if (= (getvar "UserR1") 0)
! c# @1 b: `5 d    (setvar "UserR1" 1.0)
  )
  (setq        bl (ureal 1 "" "\n输入出图比例1 " bl)
& B: u0 l% s4 g2 u        SC (/ bl 100.0)
  )
  (setvar "UserR1" (/ 1.0 sc))
  (command "modemacro"
) m  S' v1 z3 M# w           (strcat " 当前出图比例 1:"
6 g* {9 B8 c& c/ c                   (rtos bl 2 1)
           )
  )

- F6 b; U. q& V4 \- d[ 本帖最后由 summerfly2008 于 2006-4-27 10:16 编辑 ]

summerfly2008

一般程序的标准格式（参考）

PHP代码:　　　　　　　　　　　　　　　　　　　　　　　　　　　
(defun c:test ()
  (cmdla0);前置函数
  ;;核心程序
  ;;……
! Y! @& e$ r, Z! P: @5 N' k$ Y* D  ;;……
  ;;……
8 J) b, N% l. i  (cmdla1);后置函数
)

summerfly2008

二、sub_upd函数
; G, B$ j/ I4 \. f( \) ~0 A
( p5 w. @) w) L/ L4 w' X代码:
;|
功能 : 更改图元DXF组码以修改实体属性
方式 : (SUB_UPD 实体名 DXF码 新值)

实例1 : 改圆半径为500
" s" c) Z) w# A1 A1 U(sub_upd (car(entsel"\n选择圆 : ")) 40 500)

实例2 : 改文本为"晓东空间"
& k, d0 j: Z  U/ m+ a(sub_upd (car(entsel"\n选择文本 : ")) 1 "晓东空间")
" R$ b2 t5 R2 F3 ?! Z5 E
9 w: R2 {: `2 d/ X: n% |实例3 : 改块的插入点为(0 0 0)
(sub_upd (car(entsel"\n选择块 : ")) 10 '(0 0 0))
6 f/ W. u: @1 n$ V0 g
1 D# N" a0 f5 t1 [, z  L--------------------------------------------------------
4 i1 K0 N8 W/ j3 s4 I: u|;
(defun sub_upd (ename code newvalue)
  (entmod (subst (cons code newvalue)
+ c4 N) y4 Y7 h1 M3 N                 (assoc code (entget ename))
% Q4 ^0 U2 @# j7 E% V                 (entget ename)
          )
  )
" A) [6 t" d" M7 F2 n* v$ j  (entupd ename)
1 }! ~6 g2 g- J: [/ K: [4 I
4 ?! G  _+ x7 ]7 @" x# Q: v$ k[ 本帖最后由 summerfly2008 于 2006-4-27 10:17 编辑 ]

summerfly2008

三、文本排序函数 xyp-Sort-Text
代码:

$ C: e* @1 |' C* j: m;;文本排序函数  xyp-Sort-Text
;;(xyp-Sort-Text 文本选择集 模式)
;;mode : 0,按选择顺序排序；1，按Y轴由上到下排序；2，按Y轴由下到上排序；
;;可以扩充
(defun xyp-Sort-Text (sssel mode / lst)
: B3 [4 `) o; [: t# Y- Q: ^  (setq        i   -1
- Q4 @/ G% C$ d% i        lst '()
  )
9 K( Y. h9 \& Y. u  (while (setq s1 (ssname sssel (setq i (1+ i))))
    (setq pt        (dxf 10 (entget s1))        ;左下角点
! l- O: M( {; m! G1 A0 F  A; N) c          ename        (dxf -1 (entget s1))        ;实体名
$ }# q' Q5 s2 f+ r1 o; _6 Y          pt-tx        (cons pt ename)
) G) c5 Y, T1 G5 E- E  N          lst        (cons pt-tx lst)
; b: L' [* C* L% J0 _) Y! }    )
  )
+ K1 Q% w; ^) k! M# ^  (cond        ((= mode 1)
         (setq
  ]7 p( e  Z3 S. p           lst (vl-sort        lst
4 _  c; d. b- f) z+ I) F                        (function (lambda (e1 e2)
                                    (> (cadr (car e1)) (cadr (car e2)))
                                  )
                        )
               )
         )
/ x, F, Q" S, e( b, {        )
        ((= mode 2)
2 Y( k7 {/ }: N8 J, f# S         (setq
; a" N2 g' j6 P* W: _+ \5 f           lst (vl-sort        lst
                        (function (lambda (e1 e2)
3 S& q+ t, [" |' p3 f                                    (< (cadr (car e1)) (cadr (car e2)))
& f" U0 i, }  ?                                  )
$ P9 H4 @1 W# d+ T# n0 j                        )
; Z; O5 c9 E, S7 y0 R               )
$ {, w/ a9 H8 o* ^1 P! h: P         )
        )
        ((= mode 0) (princ))
        (t (princ))
: M8 }, d& A, B7 _- r8 @  )
/ ^% _9 W. ?+ L0 _+ O; z  lst
6 o3 K! i8 `7 M9 L+ G" Q4 c)

+ w; j: \2 z' ?) y: Q0 o实例：行距调整

& v- c9 T: j7 R- n: K/ |9 y5 B8 B* ~代码:

(DEFUN c:tzhj (/ ss pt1)
/ e9 u- v+ e, d" C# K( v: q5 w# s  (cmdla0)
. L6 @) d/ [6 u  (princ "\n选择文本: ")
+ T* d, u6 o- x0 D9 M( X) T  (if (null no4)
    (setq no4 1000)
  )
; M/ Z- r& l1 L, O4 v  D  (while (not (SETQ SS (ssget '((0 . "TEXT"))))))
  (WHILE (NOT (SETQ pt1 (getpoint "\n基点 : "))))
( l! a6 G& [, |! c3 L. r3 m# M  I  (setq        no4  (ureal 7 "" "\n行距" no4)
        tlst (xyp-Sort-Text ss 1)
        n    -1
        y    (cadr pt1)
  )
  (princ "\n")
  (foreach tx tlst
' U$ Y- C6 G4 w0 q+ O; `" i    (progn
      (setq s1         (cdr tx)
! ~9 d7 c, ~7 }9 T# [9 f            pt10 (car tx)
            pt1         (list (car pt10) (- y (* (setq n (1+ n)) no4)))
1 Q+ ^. M* p, b* P% ?      )
1 L" _0 v% s2 x5 S, C      (command "move" s1 "" pt10 pt1)
      (princ ".")
    )
/ t" U9 @! e+ j4 ]  )
0 i; e7 O' D' y2 m3 W1 j) _" D8 e  (princ (length tlst))
5 i5 K  H' f- z& k) U  (princ " 个文本行距调整完成!")
3 X- d% q! F5 P  (cmdla1)
8 J$ ^+ m8 y" m5 E7 E6 i* M( V)

0 {/ @' N( r3 Z[ 本帖最后由 summerfly2008 于 2006-4-27 10:17 编辑 ]

summerfly2008

四、选择集排序 xyp-Sort
xyp-Sort 是文本排序函数 xyp-Sort-Text 的扩展函数
# {+ F7 p* Q6 g5 W& D+ q  `2 I% P7 ]: G格式：(xyp-Sort 选择集 dxf组码 mode)
返回表格式 '((组码值 实体名)(组码值 实体名)(组码值 实体名))

# V6 s. y* P- ?9 F8 @0 m代码:

9 r! \7 G. t* E2 C$ c% a;;;针对选择集sssel内包含dxf组码的实体排序
;;;返回表，格式 '((组码值 实体名)(组码值 实体名)(组码值 实体名))
;;;mode : "none",按选择顺序排序；
5 R6 h, [: s! E8 A9 x
;;;点表 'LIST
" d/ u' W& y9 }! T2 j3 B2 q+ ^;;;"Y-max"，按Y轴由上到下排序；"Y-min"，按Y轴由下到上排序；
+ j2 v% E3 ]' O$ V1 x;;;"X-max"，按x轴由右到左排序；"X-min"，按x轴由左到右排序；

; r6 O# J/ e& q6 G. I% A4 {2 Z;;;值 'REAL
5 y! t( ~8 g* H4 ?& {;;;"X-max"、"Y-max"，按从大到小排序；
;;;"X-min"、"Y-min"，按从小到大排序；
1 _& d# j2 \, e% n- s. v
(defun xyp-Sort        (sssel dxfmode mode / s1 pt ename pt-tx lst)
  (setq        i    -1
# K0 N6 t: a* b2 q( b) O% T6 h        lst  '()
        mode (strcase mode)                ;转大写
* `& K! j0 y# i" H  )
  (while (setq s1 (ssname sssel (setq i (1+ i))))
# f- Y0 W( u: K& s9 u; Y9 m    (if        (setq pt (xyp-get-DXF dxfmode s1)) ;dxf组码值：10左下角点
      (progn
        (setq ename (xyp-get-DXF -1 s1)        ;实体名
+ \( n/ w/ I; r% Z, C$ f              pt-tx (cons pt ename)
              lst   (cons pt-tx lst)
' W* }" U7 V7 E! U/ Z        )
1 y# U9 G, ?4 @, Y6 C8 W) H3 v9 H      )
% z5 @3 [, C% |# L" O    )
6 u& ]# d  }5 @" Z0 D# @! j  )
; M- Q0 b% x. l* k# S8 d  (if (= (type (car (car lst))) 'LIST)        ;10 11组码 点表
+ o9 o3 Q7 E1 A" o- b) T2 v" [; w    (progn
+ T" W: K9 ?6 W9 m$ Q9 J$ @      (cond
' B* y" i6 T0 M! m& }" v4 T! ^        ((= mode "X-MAX")
% Y+ s) y! f! ]+ W         (setq
2 c; a' U9 J$ a4 P# {           lst (vl-sort        lst
8 [# q) Y8 G  b1 h1 V                        (function (lambda (e1 e2)
                                    (> (car (car e1)) (car (car e2)))
0 x/ @" {4 Q3 ?( u                                  )
7 q. v- z3 E% ]* |- @, H3 V- d                        )
               )
         )
5 E) p$ {. m- O1 J        )
        ((= mode "X-MIN")
         (setq
: C6 a0 W4 T) ]           lst (vl-sort        lst
$ h! d! S$ ?0 x3 s/ {+ s- s6 S                        (function (lambda (e1 e2)
0 ?5 S& m8 m) m5 p/ u1 Q  n, K                                    (< (car (car e1)) (car (car e2)))
                                  )
                        )
6 c4 o: S5 c* h* b' X" R& G) |! p               )
         )
' v/ P; h6 Z* C2 L9 r+ }* l8 l  [  ?        )
        ((= mode "Y-MAX")
9 R* H+ {: I6 h- U. z         (setq
- _) e( a/ q  c8 G: w) d           lst
            (vl-sort lst
                     (function (lambda (e1 e2)
                                 (> (cadr (car e1)) (cadr (car e2)))
& x! ^, c9 W" ?1 l! j' g, T                               )
                     )
; |6 G; _5 L9 F/ I& }' W            )
$ k. g. S6 e* b         )
" ~) n. [/ d9 ]+ c        )
        ((= mode "Y-MIN")
% q# z" p) G" M' T* r         (setq
           lst
, w# q6 u) l7 ~" @. F, C            (vl-sort lst
4 S* v/ |$ X8 z3 j! o9 N4 u2 Q                     (function (lambda (e1 e2)
                                 (< (cadr (car e1)) (cadr (car e2)))
                               )
                     )
            )
         )
        )
& j2 t( w. Q3 D  F* a% _3 _        ((= mode "NONE") (princ))
) s) ?( L8 O, S& K' J        (t (princ))
      )
8 c1 e( W4 O7 M    )
  )
+ R& A8 q) o: V- T  R$ S  (if (= (type (car (car lst))) 'REAL)        ;40 实数
* B" f: @. S% X: {    (progn
! m, K7 N: a1 P$ S5 H      (cond
        ((or (= mode "X-MAX") (= mode "Y-MAX"))
         (setq lst (vl-sort lst
$ @5 E2 p" B3 c1 ~' N0 d% C1 ~                            (function (lambda (e1 e2)
4 R/ i- {  b' u" t; l4 D4 Y                                        (> (car e1) (car e2))
                                      )
                            )
                   )
7 Q1 X) C6 A9 e         )
        )
        ((or (= mode "X-MIN") (= mode "Y-MIN"))
, K# f9 g* A! m         (setq lst (vl-sort lst
                            (function (lambda (e1 e2)
                                        (< (car e1) (car e2))
5 f% a% A9 k* Z                                      )
                            )
# D$ `5 F  u. R) f1 T& S3 U                   )
         )
* I5 Q9 S) p" P( t( Z) Q        )
6 p  e4 F: @6 }9 _* x2 c        ((= mode "NONO") (princ))
6 I& A& Z4 q+ b4 p7 W        (t (princ))
      )
% Y3 I2 L" P  a2 ^4 W    )
! ]2 Q1 w9 M% N  X7 l% q1 x  )  
  P2 K4 p- ^! {  lst
)


* V3 i+ n8 K8 f! v& o5 d文本调整行距程序：tzhj

  {# ]! K! x; E( x代码:
1 i7 V* o! J! q) V2 z;;;文本调整行距
(DEFUN c:tzhj (/ ss pt1)
  (cmdla0)
/ f2 t  E/ J1 T- f" i' G; c  (princ "\n选择文本: ")
  (if (null no4)
    (setq no4 1000)
2 Y* M" w7 P8 U8 b. Y: B$ Y7 ~  )
. y8 [& G4 k* S1 Y9 ?  (while (not (setq SS (ssget '((0 . "TEXT"))))))
* H- L  F$ B, H& d' f8 ?) b: o1 ]  (while (not (setq pt1 (getpoint "\n基点 : "))))
/ @3 g/ N) C* k9 w% [; o' x  (setq        no4  (ureal 7 "" "\n行距" no4)
        tlst (xyp-Sort ss 10 "Y-max")
" X  ^# X/ v0 n  g" {+ s7 l) P        n    -1
        y    (cadr pt1)
1 m+ o9 }5 W* C; e. Y0 h7 w+ N  )
  ?3 `2 y4 a8 c! T& C6 @% O  (princ "\n")
  (foreach tx tlst
    (progn
      (setq s1         (cdr tx)
            pt10 (car tx)
) E3 X) I8 y3 U/ ]) f            pt1         (list (car pt10) (- y (* (setq n (1+ n)) no4)))
      )
      (command "move" s1 "" pt10 pt1)
      (princ ".")
    )
2 b. S+ c  r5 n, V+ W( f  )
  (princ (length tlst))
5 r3 `# M+ m+ e7 Z2 c  (princ " 个文本行距调整完成!")
7 P% o+ p; l  @4 Q  (cmdla1)
, f' X  H5 Y3 h)

: B6 `+ c2 h7 C( E' n7 C7 i[ 本帖最后由 summerfly2008 于 2006-4-27 10:17 编辑 ]

summerfly2008

五、Dxf组码函数 xyp-get-Dxf
3 {1 x' j0 _& e4 t! Q代码:
& O) \4 ^2 X7 x* w! }8 z(defun xyp-get-DXF (code ename) (cdr (assoc
6 N* Q* O7 W: e! P: L0 a! j
7 h  L  C' K4 S4 x0 W/ F. a$ m' H[ 本帖最后由 summerfly2008 于 2006-4-27 10:18 编辑 ]

summerfly2008

六、比例设置函数 SETBL
2 K7 g6 h8 P7 f" {" o$ h
/ S. ^; s7 `) M4 O代码:
6 i+ I( p$ E3 _: V(defun setbl ()
7 J: I# n- P- }3 S! b% L. F  (if (null (vlax-ldata-get "dict" "bl"))
    (setq bl 100)
    (setq bl (vlax-ldata-get "dict" "bl"))
# ^, ?& Z9 _# L! r  )
* s* o: }3 E; P: w! M& w* Z3 H  (setq        bl (ureal

[ 本帖最后由 summerfly2008 于 2006-4-27 10:18 编辑 ]

summerfly2008

七、获得特定符号表的列表 xyp-get-tblnext
, d6 W3 y! N- \% j3 y) I2 r
代码:
, K  V. O! q0 |, n;;;获得特定符号表的列表
;;;有效符号表名称为Layer、Ltype、Viewx、Style、Block、Appid、Ucs、Dimstyle和 Vport
(defun xyp-get-tblnext (table-name / lst d)
  (while (setq d (tblnext table-name (null d)))
    (setq lst (cons (dxf 2 d) lst))
/ |- K  d* g% b" n  )
  (reverse lst)
  lst
9 ^1 m% Q& e8 Z5 n! W9 ?/ |1 u, w5 H)

测试：
命令: (xyp-get-tblnext "layer")
3 Y5 G1 w" k! [0 ]("阿基米德螺旋线" "建筑-厨卫" "0")
3 o2 |( F: [) f( m7 e5 \* P
[ 本帖最后由 summerfly2008 于 2006-4-27 10:19 编辑 ]

summerfly2008

8、xyp-DelSame 删除表中的重复元素


代码:
(defun xyp-DelSame (ptlst / nl lst)          
  (mapcar '(lambda (x)
             (if (not (member x nl))
1 W) d4 R" b8 j# h2 v3 [/ q+ Z               (setq nl (cons x nl))
. ~1 A- F5 E0 W8 D, _  T, A             )
1 C& G- m. s2 r8 Y           )
          ptlst
- O) }0 A: w" u  @/ y0 U  )
  (setq nl (reverse nl))
  nl
)
% n5 v1 z3 n/ g# Z. c
或

) D. N% k9 L& M" C, I0 r3 b代码:
( P" {& ?. y7 l  z4 Z8 c(defun xyp-DelSame (ptlst / nl lst)
  (foreach x ptlst
5 i8 b8 A" h/ H+ [/ B. I    (if        (not (member x nl))
      (setq nl (cons x nl))
    )
  )
  {# B- X# ^8 ]" h% C+ E2 a) l  (setq nl (reverse nl))
$ o) r  {3 w: U. H" w2 N  nl
- [8 b2 F" K) ]; J* K% ^: V* ?)
$ M2 S, q  Y  j) [/ \; Z$ K; p: f
测试：
$ ^6 Z- n# O7 DCommand: (xyp-delsame '(a a b c d a 12 3 45 12 a))
" ]- c/ S# P8 ?' F(A B C D 12 3 45)
8 n" \9 A# \1 }5 b! P
8 e0 T8 f, r, [1 G$ q1 Q# Z# {[ 本帖最后由 summerfly2008 于 2006-4-27 10:19 编辑 ]

summerfly2008

9、xyp-Text 定点写字
0 H! \8 m4 g/ j+ E
代码:
2 c' c* {) b1 w  ~$ o- H; ^;;;---------------- xyp-Text -----------------
;;;定点写字
; L- P1 R" ]! c" X- P8 P;;;(xyp-Text 点表 mode 文本)
2 ^- f" |9 H& ]2 ]  ^/ V1 J1 n;;;mode模式＝1～9，下中上9位码；其他均为MC点位
. l+ C6 I6 x, _4 T. ?: i;;; 7        8         9
! f5 i; h3 x: X  U( ?2 @  d/ h;;;  ------------------
1 o" }) w6 X1 B;;;  |                |
0 i* D7 G) A4 O2 o# r3 w; n/ g. v;;;  |                |
;;;  |                |
) X, y% R; w# {6 ~;;; 4|       5        |6
;;;  |                |
;;;  |                |
;;;  |                |
;;;  ------------------
& ]/ J! e8 p. r0 B6 Y4 U;;; 1        2         3
4 g! \) k! v; l# d9 ^1 l
" t2 E+ A0 Z' T7 D3 {(defun xyp-Text (point mode textobj)
4 Y  @9 O. u. {  (if (null sc)(setbl))
  (jzhz)
  (cond ((= mode 1)(command "text" "j" "BL" point (* sc 300) "0" textobj))
+ g. B1 y% f0 Y/ j/ x: z( Z        ((= mode 2)(command "text" "j" "BC" point (* sc 300) "0" textobj))
, u: w% c  Y3 O5 L        ((= mode 3)(command "text" "j" "BR" point (* sc 300) "0" textobj))
        ((= mode 4)(command "text" "j" "ML" point (* sc 300) "0" textobj))
. w" Y7 J: V- `+ u9 L, M        ((= mode 5)(command "text" "j" "MC" point (* sc 300) "0" textobj))
        ((= mode 6)(command "text" "j" "MR" point (* sc 300) "0" textobj))
/ n+ Z$ T( q" F        ((= mode 7)(command "text" "j" "TL" point (* sc 300) "0" textobj))
        ((= mode 8)(command "text" "j" "TC" point (* sc 300) "0" textobj))
        ((= mode 9)(command "text" "j" "TR" point (* sc 300) "0" textobj))
        (t (command "text" "j" "MC" point (* sc 300) "0" textobj))
        )  
! o. A- q0 ]/ {( x  X)
6 ^& @7 U" D/ @- u! @8 p! J* T4 s

修改版：
& Z' x' K) R0 ~' r! f# d
代码:
# ]6 U6 e, z; U. J  d- q(defun xyp-Text (point mode textobj / tmode)
  (if (null sc)(setbl))
# s0 c- W0 c8 T8 T  (jzhz)
  (cond ((= mode 1)(setq tmode "BL"))
        ((= mode 2)(setq tmode "BC"))
        ((= mode 3)(setq tmode "BR"))
" b2 t6 p, e; @3 S        ((= mode 4)(setq tmode "ML"))
5 d8 T2 z$ s4 W- x" p        ((= mode 5)(setq tmode "MC"))
        ((= mode 6)(setq tmode "MR"))
        ((= mode 7)(setq tmode "TL"))
        ((= mode 8)(setq tmode "TC"))
        ((= mode 9)(setq tmode "TR"))
        (t (setq tmode "MC"))
        )
  (command "text" "j" tmode point (* sc 300) "0" textobj)  
7 D1 l, }6 A% y1 }# l: T)


1 J8 L$ c2 ~$ {/ j- U, e+ C再修改：
+ {% G; h* a& |/ p, }  ~9 j& r8 M
/ d9 r  M) O7 `/ w4 t代码:
* d/ Y" J6 `- ^( d1 m(defun xyp-Text        (mode point textobj / tmode)
& `( P: Y: f# D- }' S  (if (null sc)
& p; J. V0 E/ H. C) R  i* D/ |2 o    (setbl)
  )
  (jzhz)
  (cond        ((= mode 1) (setq tmode "BL"))
% c' U  l' [5 s4 n" F; t' x, v, j        ((= mode 2) (setq tmode "BC"))
- `+ ]. `# E" k1 r- ]# m        ((= mode 3) (setq tmode "BR"))
        ((= mode 4) (setq tmode "ML"))
' @+ u+ D% L3 Q- C        ((= mode 5) (setq tmode "MC"))
        ((= mode 6) (setq tmode "MR"))
! j. y, }7 V1 u* Z  i        ((= mode 7) (setq tmode "TL"))
        ((= mode 8) (setq tmode "TC"))
6 _' M$ E- A0 v' l: s5 F3 f8 _        ((= mode 9) (setq tmode "TR"))
8 L8 k4 p2 ~7 |        ((or (null mode) t) (setq tmode "MC"))
6 l- x1 R3 ]+ [  )
9 K3 d& h' T4 n4 i, O  (command "text" "j" tmode point (* sc 300) "0" textobj)
7 M6 V  c7 B. r7 G% B' Y)
( |4 u" G' f3 ~0 o- P. Q) Z& q
3 Y6 M+ e  O  }' S[ 本帖最后由 summerfly2008 于 2006-4-27 10:20 编辑 ]

summerfly2008

10、xyp-get-MinMaxPoint 函数
功能：指定对象最小外接矩形的九点坐标

. h" M/ K% v. L* P代码:
;;;------------- xyp-get-MinMaxPoint -------------
7 e3 N+ Y) y' E, X2 T2 I! a;;;指定对象最小外接矩形的九点坐标
;;;(xyp-get-MinMaxPoint 实体名 参数)
;;;参数＝1～9，上中下9位码；其他均为左下角点
;;; 7        8         9 maxpoint '(x2 y2)
/ ^6 ~4 C( C. A3 {8 U;;;  ------------------
;;;  |                |
/ q& x4 k  Z8 n2 a9 j;;;  |                |
;;;  |                |
' @, _- [# f6 L  V) f8 F;;; 4|       5        |6
, B2 s- {1 _: {/ Y" r/ w1 c;;;  |                |
5 i- U1 z6 Q' t5 m; j0 o;;;  |                |
- R! b4 Z8 @" w% g- B;;;  |                |
;;;  ------------------
4 e2 P' j. ^+ H( N! H1 c;;; 1        2         3
;;;minpoint '(x1 y1 )
(defun xyp-get-MinMaxPoint (ename mode / pointmax pointmin x1 x2 y1 y2 dx dy point)
$ @* d- h" r: V+ A& W  (vla-getboundingbox
    (vlax-ename->vla-object ename)
. C  I( J0 G5 I4 _) A    'minpoint
( o# [9 {$ k* B" c$ ^1 u- R* q    'maxpoint
7 q# J+ t' [0 @+ y$ h/ h  )
  (setq        pointmax (vlax-safearray->list maxpoint)
* x  W7 K4 J& z4 y& {% `        pointmin (vlax-safearray->list minpoint)
! _% r9 F& f& T7 {4 ~, @        x1         (car pointmin)
( @  |* ^& ^5 J# a3 ~        x2         (car pointmax)
& ]' G" U5 ?, s* D8 x! m2 L        y1         (cadr pointmin)
2 K% n/ }8 g+ u+ U) p: i        y2         (cadr pointmax)
        dx         (/ (- x2 x1) 2.0)
: F  f% A, t( c! W0 W2 ~- \        dy         (/ (- y2 y1) 2.0)
  )
0 S5 ~$ P& u) u* R. s- b% j  (cond        ((= mode 1) (setq point pointmin))
        ((= mode 2) (setq point (list (+ x1 dx) y1)))
$ B$ c9 P; `& c8 |3 _" }- h2 }8 M        ((= mode 3) (setq point (list x2 y1)))
        ((= mode 4) (setq point (list x1 (+ y1 dy))))
* x: W' @3 i& I, T5 O& D1 r4 l) v        ((= mode 5) (setq point (list (+ x1 dx) (+ y1 dy))))
        ((= mode 6) (setq point (list x2 (+ y1 dy))))
: b! m3 d. N+ |4 d! P        ((= mode 7) (setq point (list x1 y2)))
2 m( m: i6 I4 D" ~* `        ((= mode 8) (setq point (list (+ x1 dx) y2)))
& i3 t" B2 @& {. R# C( Z        ((= mode 9) (setq point pointmax))
        (t (setq point pointmin))
  )
  point
. l6 U2 E3 U9 N/ s5 `& R)
! {& W: f4 D4 j
+ Z+ t( M$ x* `+ n9 j或

, m' t+ }  B3 r代码:
(defun xyp-get-MinMaxPoint (ename  mode          /         pointmax      pointmin
                            dx           dy          pt1         pt2        pt3    pt4    pt5
                            pt6           pt7          pt8         pt9        point
                           )
  (vla-getboundingbox
4 y( S; ?0 G; I3 G6 H    (vlax-ename->vla-object ename)
    'minpoint
    'maxpoint
5 [' I! I6 C2 p+ E$ n! I1 e  )
+ d; J% V* {9 c- c  (setq        pointmax (vlax-safearray->list maxpoint)
        pointmin (vlax-safearray->list minpoint)
        dx         (/ (- (car pointmax) (car pointmin)) 2.0)
: v* b3 w- C  ^        dy         (/ (- (cadr pointmax) (cadr pointmin)) 2.0)
7 {0 f5 g& L) E; P2 f2 v5 w2 T        pt1         pointmin
        pt2         (polar pt1 0 dx)
) \+ j% e; Q1 l( U0 i$ I        pt3         (polar pt2 0 dx)
* H' M+ M( p% ?; U# h        pt4         (polar pt1 (* pi 0.5) dy)
- M) Y# H* D7 |" c8 H        pt5         (polar pt4 0 dx)
        pt6         (polar pt5 0 dx)
9 X: m1 W* O& ]/ s) o        pt7         (polar pt4 (* pi 0.5) dy)
- z% k/ O: R& L  j" B' w% i& C        pt8         (polar pt7 0 dx)
        pt9         pointmax
5 N: Q% \4 p) z+ q3 V  )
2 E: I6 B. j$ ^  (cond        ((= mode 1) (setq point pt1))
        ((= mode 2) (setq point pt2))
# Y4 Y# {0 A& N  _5 M. W+ _        ((= mode 3) (setq point pt3))
3 @4 N4 @: S2 B4 l* y' f% c$ n# z0 S        ((= mode 4) (setq point pt4))
( B" X# s) O7 s' a        ((= mode 5) (setq point pt5))
8 E' F! a% o9 d0 A        ((= mode 6) (setq point pt6))
        ((= mode 7) (setq point pt7))
1 z% j! z$ W6 `0 Y' G1 ?        ((= mode 8) (setq point pt8))
        ((= mode 9) (setq point pt9))
- G& H; O% o+ `' z: q, W        (t (setq point pt1))
  )
/ `- Q1 ^/ v/ O  point
+ S  V9 ^5 h# o8 v* d1 a3 q9 ^; @: q)

[ 本帖最后由 summerfly2008 于 2006-4-27 10:20 编辑 ]

summerfly2008

11、xyp-get-RightPoint 函数
功能：两点中点之正方向点
: t  }1 ^3 }: }% d7 c2 w2 G+ x- h/ `/ f
7 [2 k8 c3 k9 L- Q/ ^: T) M
代码:
;;;两点中点之正方向点
;;;(xyp-get-RightPoint 起点 终点 离开两点连线的距离)
) `9 Y" b1 f) S7 j;;;---------- xyp-get-RightPoint ---------
: h( R+ y, I# K% k3 D(defun xyp-get-RightPoint (point1 point2 dist / pttxt ang)
* |& r$ H# i0 ~; f  (if (null sc)
    (setbl)
  )
6 M, x0 U/ F% a' N& e- \  (setq ang (rad2ang (angle point1 point2)))
5 `6 _- M- I% Q$ ?6 w  (if (or (< ang 90) (> ang 270))
7 v7 `0 a0 G5 q7 m    (setq ang (+ ang 90))
    (setq ang (- ang 90))
  )
8 F; L! |0 `* `  (setq        pttxt (polar (xyp-get-MidPoint point1 point2)
                     (ang2rad ang)
$ ?5 ^/ [& g( J0 G8 c9 l                     (* sc dist)
              )
  )
  pttxt
9 v. V: r7 r: L)
8 `: k# e6 F- ~  O% z' k
[ 本帖最后由 summerfly2008 于 2006-4-27 10:21 编辑 ]

cad

好 啊

浮出心海

看不懂,水平不行,谢谢了