ET中已知函数的整理

自贡黄明儒

ET中已知函数的整理
1 aly1004在破解ET中fas文件，这很好，可供大家学习。
2 前段时间，ll_j提出了类(apply ''((a b) (+ a b)) '(101 102))的写法供大家讨论

其实ET中提供了一些已知的函数，大家可以临摹。只不过，在没有仔细读完之前，我们并不知道这些已知函数怎么使用。换言之，这些

已经函数需要输入什么，最后输出什么，尽管有英文说明,哪有中文亲切呢。下面我整理了两个，有示例，这样理解就容易多了。
有兴趣的，把自己学习整理的已知函数ET贴出来，大家相互学习提高。
前段时间，ll_j提出了类(apply ''((a b) (+ a b)) '(101 102))的写法供大家讨论,今天我在ET的已知函数中看到了类似的写法。

1. ;;(setq lst (list (getpoint)(getpoint)(getpoint)(getpoint)));(wipeout_clipit nil lst)
   
2. (defun wipeout_clipit (na lst / A LA N NA2)
   
3.   (if na
   
4.     (entdel na)
   
5.   )                                                  
   
6.   (if (setq la (acet-layer-locked (getvar "clayer")))
   
7.     (command "_.layer" "_un" (getvar "clayer") "")
   
8.   )
   
9.   (command "_.pline")
   
10.   (setq n 0)
    
11.   (repeat (length lst)
    
12.     (setq a (nth n lst))                          ;setq
    
13.     (command a)
    
14.     (setq n (+ n 1))                                  ;setq
    
15.   )                                                  ;repeat
    
16.   (command "")
    
17. 
    
18.   (setq na2 (entlast))
    
19.   (command "_.pedit" na2 "_cl" "_x")
    
20.   (command "_.wipeout" "_n" na2 "_y")
    
21.   (if la
    
22.     (command "_.layer" "_lock" (getvar "clayer") "")
    
23.   )                                                  
    
24. )                                                  
    
25. 
    
26. ;;take a list of point ans removes duplicated points and unneeded points
    
27. ;;as a result of no angle change.
    
28. ;;去除相邻重复点，并形成封闭(plist_optimize '((1 2)(1 2)(3 4)(3 4)));((1 2) (3 4) (1 2))
    
29. (defun plist_optimize (lst / A B C D LST2 N)
    
30.   (if (not (equal (car lst) (last lst) 0.00001))
    
31.     (setq lst (append lst (list (car lst))))          
    
32.   )                                                  
    
33.   (setq n 0)
    
34.   (repeat (max 0 (- (length lst) 1))
    
35.     (setq a (nth n lst)
    
36.           b (nth (+ n 1) lst)
    
37.     )                                                  
    
38.     (if        (equal n 0)
    
39.       (setq lst2 (list a b))
    
40.     )                                                  
    
41.     (setq c (nth (max (- (length lst2) 2) 0) lst2)
    
42.           d (last lst2)
    
43.     )                                                  
    
44.     (if        (equal (angle a b)
    
45.                (angle c d)
    
46.                0.000001
    
47.         )                                          
    
48.       (setq lst2 (reverse (cdr (reverse lst2))))  
    
49.     )                                                  
    
50.     (if        (not (equal b (last lst2)))
    
51.       (setq lst2 (append lst2 (list b)))          
    
52.     )                                                  
    
53.     (setq n (+ n 1))                                  
    
54.   )                                                  
    
55.   (if (and (>= (length lst2) 4)
    
56.            (equal (angle (car lst2) (cadr lst2))
    
57.                   (angle (nth (- (length lst2) 2) lst2) (last lst2))
    
58.                   0.000001
    
59.            )                                          
    
60.       )                                                  
    
61.     (setq lst2 (cdr lst2)
    
62.           lst2 (reverse (cdr (reverse lst2)))
    
63.     )                                                  
    
64.   )                                                  
    
65.   lst2
    
66. )
    
67. ;;层是否处理锁定状态
    
68. ;;(acet-layer-locked (getvar "clayer"))
    
69. (defun acet-layer-locked (layer)
    
70.   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" layer)))))
    
71.     layer
    
72.   )
    
73. )
    

;;(setq lst (list (getpoint)(getpoint)(getpoint)(getpoint)));(wipeout_clipit nil lst)<br /> (defun wipeout_clipit (na lst / A LA N NA2)<br />   (if na<br />     (entdel na)<br />   )                                                  <br />   (if (setq la (acet-layer-locked (getvar "clayer")))<br />     (command "_.layer" "_un" (getvar "clayer") "")<br />   )<br />   (command "_.pline")<br />   (setq n 0)<br />   (repeat (length lst)<br />     (setq a (nth n lst))                          ;setq<br />     (command a)<br />     (setq n (+ n 1))                                  ;setq<br />   )                                                  ;repeat<br />   (command "")<br /> <br />   (setq na2 (entlast))<br />   (command "_.pedit" na2 "_cl" "_x")<br />   (command "_.wipeout" "_n" na2 "_y")<br />   (if la<br />     (command "_.layer" "_lock" (getvar "clayer") "")<br />   )                                                  <br /> )                                                  <br /> <br /> ;;take a list of point ans removes duplicated points and unneeded points<br /> ;;as a result of no angle change.<br /> ;;去除相邻重复点，并形成封闭(plist_optimize '((1 2)(1 2)(3 4)(3 4)));((1 2) (3 4) (1 2))<br /> (defun plist_optimize (lst / A B C D LST2 N)<br />   (if (not (equal (car lst) (last lst) 0.00001))<br />     (setq lst (append lst (list (car lst))))          <br />   )                                                  <br />   (setq n 0)<br />   (repeat (max 0 (- (length lst) 1))<br />     (setq a (nth n lst)<br />           b (nth (+ n 1) lst)<br />     )                                                  <br />     (if        (equal n 0)<br />       (setq lst2 (list a b))<br />     )                                                  <br />     (setq c (nth (max (- (length lst2) 2) 0) lst2)<br />           d (last lst2)<br />     )                                                  <br />     (if        (equal (angle a b)<br />                (angle c d)<br />                0.000001<br />         )                                          <br />       (setq lst2 (reverse (cdr (reverse lst2))))  <br />     )                                                  <br />     (if        (not (equal b (last lst2)))<br />       (setq lst2 (append lst2 (list b)))          <br />     )                                                  <br />     (setq n (+ n 1))                                  <br />   )                                                  <br />   (if (and (>= (length lst2) 4)<br />            (equal (angle (car lst2) (cadr lst2))<br />                   (angle (nth (- (length lst2) 2) lst2) (last lst2))<br />                   0.000001<br />            )                                          <br />       )                                                  <br />     (setq lst2 (cdr lst2)<br />           lst2 (reverse (cdr (reverse lst2)))<br />     )                                                  <br />   )                                                  <br />   lst2<br /> )<br /> ;;层是否处理锁定状态<br /> ;;(acet-layer-locked (getvar "clayer"))<br /> (defun acet-layer-locked (layer)<br />   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" layer)))))<br />     layer<br />   )<br /> )<br />

vlisp2012

继续啊

自贡黄明儒

vlisp2012 发表于 2013-9-2 15:18
继续啊

你也整点3

;; Pline width change
;;改多段线 线宽(chgplwidths (ssget '((0 . "*POLYLINE"))) 50)
(defun chgplwidths (plines newWidth / count ent subEntity currVertex)
  (setq count 0)
  (while (< count (sslength plines))
    (setq ent (entget (ssname plines count)))
    (if        (= (cdr (assoc 0 ent)) "LWPOLYLINE")
      (command "_.pedit"
               (ssname plines count)
               "_width"
               newWidth
               "_exit"
      )
      (progn                                          ;polylines
        (setq subEntity (entnext (ssname plines count)))
        (setq currVertex (entget subEntity))
        (while (not (equal "SEQEND" (cdr (assoc 0 currVertex))))
          (setq        currVertex
                 (subst (cons 40 NewWidth) (assoc 40 currVertex) currVertex)
          )
          (setq        currVertex
                 (subst (cons 41 NewWidth) (assoc 41 currVertex) currVertex)
          )
          (entmod currVertex)
          (setq subEntity (entnext (cdr (assoc -1 currVertex))))
          (setq currVertex (entget subEntity))
        )                                          ;while
        (entupd (ssname plines count))
      )                                                  ;progn
    )                                                  ;if
    (setq count (1+ count))
  )                                                  ;while
)

;; Pline modification to close
;;使多段线闭合(chgplclose (ssget '((0 . "*POLYLINE"))))
(defun chgplclose (plines / count)
  (setq count 0)
  (while (< count (sslength plines))
    (command "_.pedit" (ssname plines count) "_close" "_exit")
    (setq count (1+ count))
  )
)

;; Pline modification to open
;;闭合多段线开(chgplopen (ssget '((0 . "*POLYLINE"))))
(defun chgplopen (plines / count)
  (setq count 0)
  (while (< count (sslength plines))
    (command "_.pedit" (ssname plines count) "_open" "_exit")
    (setq count (1+ count))
  )
)

;; Pline vertex linetype generation switch
;;1 = Extra vertex created by curve-fitting
;;2 = Curve-fit tangent defined for this vertex. A curve-fit tangent direction of 0 may be omitted from DXF output but is significant if this bit is set
;;4 = Not used
;;8 = Spline vertex created by spline-fitting
;;16 = Spline frame control point
;;32 = 3D polyline vertex
;;64 = 3D polygon mesh
;;128 = Polyface mesh vertex
;;(chgltgen (ssget '((0 . "*POLYLINE"))))
(defun chgltgen        (plines / count new70 opt ent)
  (setq count 0)
  (initget 0 "ON OFF eXit _ON OFF eXit")
  (setq opt (getkword "Full PLINE linetype? [ON/OFF/eXit] <eXit>: "))
  (if opt
    opt
    "eXit"
  )
  (if (= opt "ON")
    (while (< count (sslength plines))
      (setq ent (entget (ssname plines count)))
      (setq new70 (cons 70 (logior 128 (cdr (assoc 70 ent)))))
      (setq ent (subst new70 (assoc 70 ent) ent))
      (entmod ent)
      (setq count (1+ count))
    )                                                  ;while
  )                                                  ;if on
  (if (= opt "OFF")
    (while (< count (sslength plines))
      (setq ent (entget (ssname plines count)))
      (setq new70 (cons 70 (boole 6 128 (cdr (assoc 70 ent)))))
      (setq ent (subst new70 (assoc 70 ent) ent))
      (entmod ent)
      (setq count (1+ count))
    )                                                  ;while
  )                                                  ;if off
)
(setq plines (ssget))

;; Pline decurve
;;多段线中弧线变直(chgdecurve (ssget '((0 . "*POLYLINE"))))
(defun chgdecurve (plines / count)
  (setq count 0)
  (while (< count (sslength plines))
    (command "_.pedit" (ssname plines count) "_decurve" "_exit")
    (setq count (1+ count))
  )                                                  ;while
)

;; Pline curve fit
;;多段线拟合(chgfit (ssget '((0 . "*POLYLINE"))))
(defun chgfit (plines / count)
  (setq count 0)
  (while (< count (sslength plines))
    (command "_.pedit" (ssname plines count) "_fit" "_exit")
    (setq count (1+ count))
  )                                                  ;while
)

;; Pline spline fit
;;多段线变成spline进行拟合(chgspline (ssget))
(defun chgspline (plines / count)
  (setq count 0)
  (while (< count (sslength plines))
    (command "_.pedit" (ssname plines count) "_spline" "_exit")
    (setq count (1+ count))
  )                                                  ;while
)

;; Convert arcs and lines to polylines
;; ss is retained as a duplicate of the plines selection set because
;; after conversion, new handles are assigned to what were arcs and lines
;;线、弧转换成轻多段线(convert (ssget '((0 . "LINE,ARC"))))
(defun convert (plines / ss count opt)
  (if (> (sslength plines) 0)
    (progn
      (initget 0 "Yes No _Yes No")
      (setq opt        (getkword
                  "Convert Lines and Arcs to polylines? [Yes/No] <Yes>: "
                )
      )
    )                                                  ;progn then
  )                                                  ;if
  (if (not opt)
    (setq opt "Yes")
  )
  (if (and (= opt "Yes")
           (> (sslength plines) 0)
      )                                                  ;and
    (progn                                          ;if yes -- convert lines and arcs to polylines
      (setq ss (ssadd))
      (setq count 0)
      (while (< count (sslength plines))
        (if (or        (equal (assoc 0 (entget (ssname plines count)))
                       '(0 . "ARC")
                )
                (equal (assoc 0 (entget (ssname plines count)))
                       '(0 . "LINE")
                )
            )                                          ;or
          (progn
            (command "_.pedit" (ssname plines count) "_yes" "_exit")
            (ssadd (entlast) ss)
          )                                          ;progn true
          (ssadd (ssname plines count) ss)
        )                                          ;if
        (setq count (1+ count))
      )                                                  ;while
    )                                                  ;progn yes
    (progn                                          ;if no -- do not convert
      (setq ss plines)
      (setq count 0)
      (while (< count (sslength ss))
        (if (or        (equal (assoc 0 (entget (ssname ss count))) '(0 . "ARC"))
                (equal (assoc 0 (entget (ssname ss count))) '(0 . "LINE"))
            )                                          ;or
          (progn
            (ssdel (ssname ss count) ss)
            (setq count (1- count))
          )                                          ;progn true
        )                                          ;if
        (setq count (1+ count))
      )                                                  ;while
    )                                                  ;progn no
  )                                                  ;if
  (if (and ss
           (equal (type ss) 'PICKSET)
           (equal 0 (sslength ss))
      )                                                  ;and
    (setq ss nil)
  )                                                  ;if
  ss
)

自贡黄明儒

从选择集中分离出指定类型的选择集

1. ;;从选择集中分离出指定类型的选择集
   
2. ;;(acet-pljoin-ss-flt (ssget "X") (list(cons 0 "CIRCLE")))
   
3. (defun acet-pljoin-ss-flt (ss flt )
   
4.   (if (and ss
   
5.            (> (sslength ss) 0)
   
6.       )                                                  
   
7.     (progn
   
8.       (command "_.select" ss "")
   
9.       (setq ss (ssget "_p" flt))
   
10.     )                                                  
    
11.     (setq ss nil)
    
12.   )
    
13.   ss
    
14. )

;;从选择集中分离出指定类型的选择集<br /> ;;(acet-pljoin-ss-flt (ssget "X") (list(cons 0 "CIRCLE")))<br /> (defun acet-pljoin-ss-flt (ss flt )<br />   (if (and ss<br />            (> (sslength ss) 0)<br />       )                                                  <br />     (progn<br />       (command "_.select" ss "")<br />       (setq ss (ssget "_p" flt))<br />     )                                                  <br />     (setq ss nil)<br />   )<br />   ss<br /> )

dz-2011

前排支持,大师真牛!

自贡黄明儒

1. ;;;    TEXTFIT.LSP
   
2. (defun c:textfit (/ ename textent newend tmp start newpt val ltc_% ss txtsz)
   
3.   (acet-error-init
   
4.     (list
   
5.       (list "cmdecho" 0 "snapang" 0 "limcheck" 0 "orthomode" 1)
   
6.       T                                                  ;flag. True means use undo for error clean up.
   
7.     )
   
8.   )
   
9.   (if (not (and
   
10.              (setq ss (ssget "_i"))
    
11.              (= (sslength ss) 1)
    
12.              (setq ename (ssname ss 0)
    
13.              )
    
14.            )
    
15.       )
    
16.     (setq ename (car (entsel "\nSelect Text to stretch or shrink:")))
    
17.   )
    
18. 
    
19. 
    
20.   (cond
    
21.     ((not (setq        textent        (if ename
    
22.                           (entget ename)
    
23.                         )
    
24.           )
    
25.      )
    
26.      (princ "\nNo object selected!")
    
27.     )
    
28.     ((/= (acet-dxf 0 textent) "TEXT")
    
29.      (princ "\nSelected object is not Text!")
    
30.     )
    
31.     ((acet-layer-locked (acet-dxf 8 textent))
    
32.      (princ "\nSelected object is on a locked layer!")
    
33.     )
    
34.     (t
    
35.      (setq txtsz (textbox textent))
    
36.      ;;文字宽度newend
    
37.      (setq newend (distance
    
38.                     (list
    
39.                       (caadr txtsz)                  ;upper right x coord
    
40.                       (cadar txtsz)                  ;lower left y coord
    
41.                     )
    
42.                     (car txtsz)
    
43.                     ;; ll xyz
    
44.                   )
    
45.      )
    
46.      ;;set snap along text entity
    
47.      (setvar "snapang"
    
48.              (angtof (angtos (acet-dxf 50 textent) 0 8) 0)
    
49.      )
    
50.      (initget 0 "Start _Start")
    
51.      (setq
    
52.        tmp (getpoint (acet-dxf 10 textent)
    
53.                      "\nSpecify end point or [Start point]: "
    
54.            )
    
55.      )
    
56.      (setvar "snapang" 0)
    
57.      (cond
    
58.        ((= (type tmp) 'STR)
    
59.         ;;new starting point to be selected
    
60.         (setq start (getpoint "\nSpecify new starting point: "))
    
61.         (if start
    
62.           (progn
    
63.             (command "_.UCS" "_E" (acet-dxf -1 textent))
    
64.             (setvar "orthomode" 1);正交
    
65.             (setq newpt
    
66.                    (if start
    
67.                      (getpoint (trans start 0 1) " ending point: ")
    
68.                      nil
    
69.                    )                                  ;if
    
70.             )                                          ;setq
    
71.             (if        newpt
    
72.               (setq newpt (trans newpt 1 0))
    
73.             )
    
74.             (setvar "orthomode" 0)
    
75.             (command "_.UCS" "_W");世界坐标系
    
76.           )                                          
    
77.         )
    
78.         if
    
79.        )
    
80.        ((not (null tmp))
    
81.         ;;new ending point selected
    
82.         (setq start (acet-dxf 10 textent)
    
83.               newpt tmp
    
84.         )
    
85.        )
    
86.        (t
    
87.         (setq start nil
    
88.               newpt nil
    
89.         )
    
90.        )
    
91.      )                                                  ;cond
    
92.      (if (and start newpt)
    
93.        (progn
    
94.          (setq val     (assoc 41 textent)
    
95.                ;;current width factor
    
96.                val     (if val
    
97.                          (cdr val)
    
98.                          1.0
    
99.                        )
    
100.                ltc_%   (* (/ (distance start newpt) newend) val)
     
101.                textent (subst (cons 41 ltc_%)
     
102.                               (assoc 41 textent)
     
103.                               textent
     
104.                        )
     
105.                textent (subst (cons 10 start)
     
106.                               (assoc 10 textent)
     
107.                               textent
     
108.                        )
     
109.                textent (subst (cons 11 newpt)
     
110.                               (assoc 11 textent)
     
111.                               textent
     
112.                        )
     
113.          )                                          ;setq
     
114.          (entmod textent)
     
115.          (entupd (acet-dxf -1 textent))
     
116.        )
     
117.      )
     
118.      ;;end of points check
     
119.     )
     
120.   )                                                  ;cond
     
121.   (acet-error-restore)
     
122.   (princ)
     
123. )                                                  ;end defun
     
124. 
     
125. 
     
126. 
     
127. 
     
128. (defun c:TFHELP        (/)
     
129.   (prompt
     
130.     " TEXTFIT will change the width factor of the selected text, \n"
     
131.   )
     
132.   (prompt " to fit within the user specified points.\n")
     
133.   (prompt "\n")
     
134.   (prompt
     
135.     " TEXTFIT will prompt:  Select Text to stretch/shrink:\n"
     
136.   )
     
137.   (prompt " The user is expected to select the text.\n")
     
138.   (prompt "\n")
     
139.   (prompt
     
140.     " TEXTFIT will then prompt:  Specify starting Point/<select new ending point>: \n"
     
141.   )
     
142.   (prompt
     
143.     " At which time the user can specify a new ending point \n"
     
144.   )
     
145.   (prompt "                          or\n")
     
146.   (prompt
     
147.     " The user can provide the letter \"S\" for a new starting point\n"
     
148.   )
     
149.   (prompt
     
150.     " to which TEXTFIT will prompt:  Specify new starting point:  \n"
     
151.   )
     
152.   (prompt " and:  ending point: \n")
     
153.   (textscr)
     
154.   (princ)
     
155. )
     
156. 
     
157. (defun ACET-DXF        (CODE E1)
     
158.   (CDR (ASSOC CODE E1))
     
159. )
     
160. (defun acet-layer-locked (layer)
     
161.   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" layer)))))
     
162.     layer
     
163.   )
     
164. )
     

;;;    TEXTFIT.LSP<br /> (defun c:textfit (/ ename textent newend tmp start newpt val ltc_% ss txtsz)<br />   (acet-error-init<br />     (list<br />       (list "cmdecho" 0 "snapang" 0 "limcheck" 0 "orthomode" 1)<br />       T                                                  ;flag. True means use undo for error clean up.<br />     )<br />   )<br />   (if (not (and<br />              (setq ss (ssget "_i"))<br />              (= (sslength ss) 1)<br />              (setq ename (ssname ss 0)<br />              )<br />            )<br />       )<br />     (setq ename (car (entsel "\nSelect Text to stretch or shrink:")))<br />   )<br /> <br /> <br />   (cond<br />     ((not (setq        textent        (if ename<br />                           (entget ename)<br />                         )<br />           )<br />      )<br />      (princ "\nNo object selected!")<br />     )<br />     ((/= (acet-dxf 0 textent) "TEXT")<br />      (princ "\nSelected object is not Text!")<br />     )<br />     ((acet-layer-locked (acet-dxf 8 textent))<br />      (princ "\nSelected object is on a locked layer!")<br />     )<br />     (t<br />      (setq txtsz (textbox textent))<br />      ;;文字宽度newend<br />      (setq newend (distance<br />                     (list<br />                       (caadr txtsz)                  ;upper right x coord<br />                       (cadar txtsz)                  ;lower left y coord<br />                     )<br />                     (car txtsz)<br />                     ;; ll xyz<br />                   )<br />      )<br />      ;;set snap along text entity<br />      (setvar "snapang"<br />              (angtof (angtos (acet-dxf 50 textent) 0 8) 0)<br />      )<br />      (initget 0 "Start _Start")<br />      (setq<br />        tmp (getpoint (acet-dxf 10 textent)<br />                      "\nSpecify end point or [Start point]: "<br />            )<br />      )<br />      (setvar "snapang" 0)<br />      (cond<br />        ((= (type tmp) 'STR)<br />         ;;new starting point to be selected<br />         (setq start (getpoint "\nSpecify new starting point: "))<br />         (if start<br />           (progn<br />             (command "_.UCS" "_E" (acet-dxf -1 textent))<br />             (setvar "orthomode" 1);正交<br />             (setq newpt<br />                    (if start<br />                      (getpoint (trans start 0 1) " ending point: ")<br />                      nil<br />                    )                                  ;if<br />             )                                          ;setq<br />             (if        newpt<br />               (setq newpt (trans newpt 1 0))<br />             )<br />             (setvar "orthomode" 0)<br />             (command "_.UCS" "_W");世界坐标系<br />           )                                          <br />         )<br />         if<br />        )<br />        ((not (null tmp))<br />         ;;new ending point selected<br />         (setq start (acet-dxf 10 textent)<br />               newpt tmp<br />         )<br />        )<br />        (t<br />         (setq start nil<br />               newpt nil<br />         )<br />        )<br />      )                                                  ;cond<br />      (if (and start newpt)<br />        (progn<br />          (setq val     (assoc 41 textent)<br />                ;;current width factor<br />                val     (if val<br />                          (cdr val)<br />                          1.0<br />                        )<br />                ltc_%   (* (/ (distance start newpt) newend) val)<br />                textent (subst (cons 41 ltc_%)<br />                               (assoc 41 textent)<br />                               textent<br />                        )<br />                textent (subst (cons 10 start)<br />                               (assoc 10 textent)<br />                               textent<br />                        )<br />                textent (subst (cons 11 newpt)<br />                               (assoc 11 textent)<br />                               textent<br />                        )<br />          )                                          ;setq<br />          (entmod textent)<br />          (entupd (acet-dxf -1 textent))<br />        )<br />      )<br />      ;;end of points check<br />     )<br />   )                                                  ;cond<br />   (acet-error-restore)<br />   (princ)<br /> )                                                  ;end defun<br /> <br /> <br /> <br /> <br /> (defun c:TFHELP        (/)<br />   (prompt<br />     " TEXTFIT will change the width factor of the selected text, \n"<br />   )<br />   (prompt " to fit within the user specified points.\n")<br />   (prompt "\n")<br />   (prompt<br />     " TEXTFIT will prompt:  Select Text to stretch/shrink:\n"<br />   )<br />   (prompt " The user is expected to select the text.\n")<br />   (prompt "\n")<br />   (prompt<br />     " TEXTFIT will then prompt:  Specify starting Point/<select new ending point>: \n"<br />   )<br />   (prompt<br />     " At which time the user can specify a new ending point \n"<br />   )<br />   (prompt "                          or\n")<br />   (prompt<br />     " The user can provide the letter \"S\" for a new starting point\n"<br />   )<br />   (prompt<br />     " to which TEXTFIT will prompt:  Specify new starting point:  \n"<br />   )<br />   (prompt " and:  ending point: \n")<br />   (textscr)<br />   (princ)<br /> )<br /> <br /> (defun ACET-DXF        (CODE E1)<br />   (CDR (ASSOC CODE E1))<br /> )<br /> (defun acet-layer-locked (layer)<br />   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" layer)))))<br />     layer<br />   )<br /> )<br />

杨如迁

前排支持,大师真牛!

linshiyin2

，整理出来就一系列函数集了，相当于lisp增加了新函数

sixth

顶下，这个确实很好，前面想提出它的layer 相关命令，搞半天，搞不定，不知道缺了什么东东

午夜的风

我想，LAYER可能不是用lisp写的