[编程交流] 圆角API

(defun code-value (key ename)
 (cdr (assoc key (entget ename)))
) ;_ end of  defun
;;;Listing 10.9. Retrieving the value associated with a DXF group code.
(defun ent-text
      (txt-string style pt1 pt2 txt-height h-just v-just)
 (entmake (list '(0 . "TEXT")
                '(100 . "AcDbEntity")
                '(100 . "AcDbText")
                (cons 1 txt-string)
                (cons 7 style)
                (cons 10 pt1)
                (cons 11 pt2)
                (cons 40 txt-height)
                (cons 72 h-just)
                (cons 73 v-just)
          ) ;_ end of list
 ) ;_ end of entmake
) ;_ end of defun
;;;Listing 10.12. Fuction that creates a single line text entity.
(defun endpoint-circle
                      (radius / lines i line-ent pin pfi)
 (if (setq lines (ssget "X" '((0 . "LINE"))))
   (progn (setq i 0)
          (while (setq line-ent (ssname lines i))
            (setq pin (code-value 10 line-ent)
                  pfi (code-value 11 line-ent)
            ) ;_ end of setq
            (if (not (member pin drawn))
              (progn (vl-cmdf "._circle" pin radius)
                     (setq drawn (cons pin drawn))
              ) ;_ end of progn
            ) ;_ end of if
            (if (not (member pfi drawn))
              (progn (vl-cmdf "._circle" pfi radius)
                     (setq drawn (cons pfi drawn))
              ) ;_ end of progn
            ) ;_ end of if
            (setq i (1+ i))
          ) ;_ end of while
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun
;;;Listing 12.2. Function that draws circles at the line endpoints.
(defun trim-line-circle (/ circles lines obj endpoints)
 (if (and (setq circles (ssget "X" '((0 . "CIRCLE"))))
          (setq lines (ssget "X" '((0 . "LINE"))))
     ) ;_ end of and
   (progn (setq i 0)
          (while (setq obj (ssname lines i))
            (setq endpoints (cons (code-value 11 obj)
                                  (cons (code-value 10 obj)
                                        endpoints
                                  ) ;_ end of cons
                            ) ;_ end of cons
                  i         (1+ i)
            ) ;_ end of setq
          ) ;_ end of while
          (foreach pt endpoints
            (vl-cmdf "._trim" circles "" pt "")
          ) ;_ end of foreach
          (if (> (getvar "cmdactive") 0)
            (vl-cmdf)
          ) ;_ end of if
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun
;;;Listing 12.3. Function that demonstrates the use of TRIM from a VLISP function.
(defun number-nodes (pt-lst height / i pt)
 (setq pt-lst
        (vl-sort pt-lst
                 '(lambda (pt1 pt2) (> (cadr pt1) (cadr pt2)))
        ) ;_ end of vl-sort
 ) ;_ end of setq
 (setq i 0)
 (while (setq pt (nth i pt-lst))
   (ent-text (itoa (1+ i))
             (getvar "textstyle")
             pt
             pt
             height
             1
             2
   ) ;_ end of ent-text
   (setq i (1+ i))
 ) ;_ end of while
) ;_ end of defun
;;;Listing 12.4. Graph nodes numbering function.
(defun C:GRAPH (/ *error* radius drawn)
 (defun *error* (msg)
   (vl-cmdf "_UNDO" "_END")
   (vl-cmdf "_U")
   (setvar "osmode" oom)
   (prompt msg)
 ) 
 (setq oom (getvar "osmode"))
 (setvar "osmode" 0)
 (vl-cmdf "_UNDO" "_BEGIN")
 (setq radius (getreal "\nSpecify cirle radius: " ))
 (endpoint-circle radius)
 (trim-line-circle)
 (number-nodes drawn radius)
 (vl-cmdf "_UNDO" "_END")
 (setvar "osmode" oom)
 (princ)
)
;;;Listing 12.5. New command that automates the creation of network diagrams.