[编程交流] 将直线更改为矩形

(defun c:l2r ( /  ss e ent ang pts)
     (if (not width) (setq width 1.00))
     (setq width (cond
                      ((getdist
                             (strcat "\nEnter Width <"
                                     (rtos width 2 2)
                                     ">: ")))
                      (width)))
(if          (setq ss (ssget '((-4 . "<OR")
           (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>")
           (0 . "LINE")(-4 . "OR>"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (Setq i (1- i))))
      (setq ent (entget e)
     ang (angle        (setq sp (vlax-curve-getStartPoint e))
                (setq ep (vlax-curve-getendPoint e))
         )
      )
      (setq pts (mapcar
           '(lambda (pt)
              (list (setq
                      p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width))
                    )
                    (polar p_ (+ ang (* pi 1.5)) width)
              )
            )
           (list sp ep)
         )
     pts (apply 'append (list (car pts) (reverse (cadr pts))))
      )
      (entmakex
 (append (list (cons 0 "LWPOLYLINE")
               (cons 100 "AcDbEntity")
               (assoc 8 ent)
               (cons 100 "AcDbPolyline")
               (cons 90 (length pts))
               (cons 70 1)
         )
         (mapcar (function (lambda (p) (cons 10 p))) pts)
 )
      )
      (entdel e)
    )
  )
 )

(defun c:l2r2 ( /  ss i e pts ob)
(setq pac (getvar 'peditaccept))
(setvar 'peditaccept 1)
     (if (not width) (setq width 1.00))
     (setq width (cond
                      ((getdist
                             (strcat "\nEnter Width <"
                                     (rtos width 2 2)
                                     ">: ")))
                      (width)))  
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE"))))
  (repeat (setq i (sslength ss))
                  (setq e (ssname ss (Setq i (1- i))) sss (ssadd))
                (setq pts (mapcar
                            '(lambda (y)
                               (list (vlax-curve-getStartPoint y)
                                       (vlax-curve-getEndPoint y)
                                     )
                               )
                        (mapcar 'car
                              (mapcar
                                '(lambda (x)
                                   (setq ob (vlax-invoke
                                     (vlax-ename->vla-object e)
                                     'Offset
                                     x
                                   )
                                )         
                                   (ssadd (entlast) sss)
                                        ob
                                 )
                                (list (setq h (* 0.5 width))
                                      (- h)
                                )
                              )
                                )
                            )
                      )
                    (mapcar '(lambda (k l)
                           (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
                           (ssadd (entlast) sss)
                           )
                        (car pts)(cadr pts)
                        )
                   (command "_.pedit" "_m" sss ""  "_j" 0.0 "")
            (entdel e)
    )
)
 (setvar 'peditaccept pac)
 (princ)
 )

Command: pedit
Select polyline: (pause) or ename
Object selected is not a polyline
Do you want to turn it into one? <Y> y
Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo/eXit <X>: Width
Enter new width for all segments: 0.5
Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo/eXit <X>:eXit

; Covert multiple lines or plines to rectangles with given width 
; 21 MAR 2014 @ MELBOURNE
; [email="yxinst@gmail.com"]yxinst@gmail.com[/email]
(vl-load-com)
(princ)
(defun c:L2REC (/ _ss->lst subl2rec ss obs odist )
 (defun _ss->lst (sset / i lst)
   (setq i 0)
   (while (< i (sslength sset))
     (setq lst (cons (vlax-ename->vla-object (ssname sset i)) lst))
     (setq i (+ i 1))
   )
   lst
 )
 ;offset in 2 directions and link ends
 (defun subl2rec (oblst dist / l1 l2 l3 l4 temp pt11 pt12 pt21 pt22)
   (mapcar '(lambda (x)
       (setq l1 (vlax-vla-object->ename
    (car (vlax-safearray->list
    (vlax-variant-value (vla-offset x dist))
         )
    )
  )
      l2 (vlax-vla-object->ename
    (car (vlax-safearray->list
    (vlax-variant-value (vla-offset x (- 0 dist)))
         )
    )
  )
       )
       (if (/= "LINE" (cdr (assoc 0 (entget l1))))
  (progn (command "_explode" l1)
  (setq l1 (entlast))
  (command "_explode" l2)
  (setq l2 (entlast))
  )
       )
       (setq pt11 (cdr (assoc 10 (entget l1)))
      pt12 (cdr (assoc 11 (entget l1)))
      pt21 (cdr (assoc 10 (entget l2)))
      pt22 (cdr (assoc 11 (entget l2)))
       )
       (if (equal (distance pt11 pt22) (* 2 dist))
  (setq temp pt22
        pt22 pt21
        pt21 temp
  )
       )
       (command "_line" pt11 pt21 "")
       (setq l3 (entlast))
       (command "_line" pt12 pt22 "")
       (setq l4 (entlast))
       (command "_pedit" l1 "y" "j" l3 "" "j" l2 "" "j" l4 "" "")
     )
    oblst
   )
 )
 (princ "Select multiple lines or plines please.")
 (setq ss (ssget))
 (setq obs (_ss->lst ss))
 (setq odist (/ (getreal "Width?: ") 2))
 (subl2rec obs odist)
 (command "erase" ss "")
 (princ)
)