[编程交流] 具有方形边缘的缓冲区。

(defun c:buffer (/ eLast ent obj wid)
 (vl-load-com)
 ; Lee Mac  ~  25.01.10
 
 (or *def_wid* (setq *def_wid* 10.))
 (setq *def_wid* (cond ((getdist (strcat "\nSpecify Width <" (rtos *def_wid*) "> : ")))
                       (*def_wid*)))
 (setq eLast (entlast))
 (command "_.pline")
 (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command pause))
 (if (not (eq eLast (setq ent (entlast))))
   (progn
     (setq obj (vlax-ename->vla-object ent) wid (/ *def_wid* 2.))
     
     (mapcar
       (function
         (lambda (x)
           (vla-offset x (setq wid (- wid))))) (list obj obj))
     (entdel ent)))
 (princ))

(defun c:trpath (/ ss en ed pl closed fe tw)
 (while (or (not ss)
            (/= (sslength ss) 1))
        (princ "\nSelect Polyline Path")
        (setq ss (ssget '((0 . "*POLYLINE")))))
 (setq en (ssname ss 0)
       ed (entget en)
       pl (findpath en))
 (if (= (logand (cdr (assoc 70 ed)) 1) 1)
     (setq pl (append pl (list (cadr pl)))
           pl (append pl (list (caddr pl)))
           closed T))
 (entmake (list (cons 0 "POINT")(cons 10 (car pl))))
 (setq fe (entlast))
 (initget 7)
 (setq tw (getdist "\nTRACE Width:   "))
 (setvar "TRACEWID" tw)
 (command "_.TRACE" "")
 (foreach p pl
   (command p))
 (command "")
 (and closed
      (entdel fe)
      (entdel (entnext fe))
      (entdel (entlast)))
 (redraw)
 (prin1))
;++++++++++++ FINDPATH +++++++++++++++++++++++++++++++++++++++++++
;;;Returns ECS Point Values Of PLINE
(defun findpath (en / pl ed sp_flg cl_flg bf nl i vp bf vf pl_flg)
 (if (= "LWPOLYLINE" (cdr (assoc 0 (entget en))))
     (command "_.CONVERTPOLY" "_Heavy" en ""))
 (setq ed (entget en))
 (setq pl_flg (cdr (assoc 70 ed)))
 (and (= (logand pl_flg 1) 1)
      (setq cl_flg T))
 (and (= (logand pl_flg 4) 4)
      (setq sp_flg T))
 (and (or (= (logand pl_flg 16) 16)
          (= (logand pl_flg 64) 64))
      (princ "\nInvalid POLYLINE Mesh")
      (exit))
 (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
        (setq en (entnext en)
              ed (entget en)
              vp (cdr (assoc 10 ed))
              bf (cdr (assoc 42 ed))
              vf (cdr (assoc 70 ed)))
        (cond ((and (not cl_flg)
                    (= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
               (setq pl (cons vp pl)))
              ((and (/= bf 0.0)
                    (/= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
               (add_arc vp (cdr (assoc 10 (entget (entnext en)))) bf))
              ((and (/= bf 0.0)
                    cl_flg
                    (= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
               (add_arc vp (last pl) bf))
              ((and (= bf 1.0)
                    (not cl_flg)
                    (= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
               (princ))
              ((and sp_flg
                    (= bf 0.0)
                    (= (logand vf  8))
               (setq pl (cons vp pl)))
              ((and (not sp_flg)
                    (= bf 0.0)
                    (/= (logand vf  8))
               (setq pl (cons vp pl)))))
 (if (and cl_flg
          (not (equal (car pl) (last pl))))
     (setq pl (cons (last pl) pl)))
 (setq i 0)
 (while (< i (length pl))
        (while (equal (nth i pl) (nth (1+ i) pl) 0.0001)
               (setq i (1+ i)))
        (and (nth i pl)
             (setq nl (cons (nth i pl) nl)))
        (setq i (1+ i)))
  nl)
(defun add_arc (sp ep bulge / alist x1 x2 y1 y2 cotbce
               ce ra sa ea ia inc qty na temp)
 (setq x1 (car sp);;Modified Bulge
       x2 (car ep);;Conversion By
       y1 (cadr sp);;Duff Kurland
       y2 (cadr ep);;Autodesk, Inc.
   cotbce (/ (- (/ 1.0 bulge) bulge) 2.0)
       ce (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)
                (/ (+ y1 y2    (* (- x2 x1) cotbce) ) 2.0)
                (caddr sp))
       ra (distance ce sp)
       sa (atan (- y1 (cadr ce)) (- x1 (car ce)))
       ea (atan (- y2 (cadr ce)) (- x2 (car ce))))
 (if (minusp sa)
     (setq sa (+ sa (* 2.0 pi))))
 (if (minusp ea)
     (setq ea (+ ea (* 2.0 pi))))
 (if (minusp bulge)
     (setq temp sa sa ea ea temp))
 (if (> sa ea)
     (setq ia (+ (- (* pi 2.0) sa) ea))
     (setq ia (- ea sa)))
 (setq qty (abs (fix (/ ia (/ pi 16)))));;;ADJUST 16 FOR SMOOTHNESS
 (if (< qty 2)
     (setq qty 2))
 (setq na sa
      inc (/ (abs ia) qty))
 (repeat (1+ qty)
     (setq alist (cons (polar ce na ra) alist)
              na (+ sa inc)
              sa na))
 (if (not (equal sp (car alist) 0.0001))
     (setq alist (reverse alist)))
 (foreach a alist
     (setq pl (cons a pl))))

CMDACTIVE        
Bit-code indicates what type of command is active:
1=ordinary command
2=ordinary and transparent command
4=script active
8=dialogue box active

(while (> (getvar "CMDACTIVE") 0) ....