[编程交流] 如何在l周围创建间隙

(defun c:test (/ *error* dxf s ss of obj in nm lst p)
 ;;--- Tharwat 19. April. 2013 ---;;
 (defun *error* (x)
   (setvar 'cmdecho 1)
   (princ (strcat "\n Error ... " x))
 )
 (defun dxf (n o) (cdr (assoc n (entget o))))
 (if (and (progn (princ "\n Select single line ... >> ")
                 (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
          )
          (setq ss (ssget "_X" '((0 . "LINE"))))
          (setq of (getdist "\n Specify offset distance :"))
     )
   (progn
     (setq obj (vlax-ename->vla-object (ssname s 0)))
     (repeat (setq in (sslength ss))
       (if
         (not
           (eq 4
               (logand
                 4
                 (cdr
                   (assoc
                     70
                     (entget
                       (tblobjname
                         "LAYER"
                         (dxf 8 (setq nm (ssname ss (setq in (1- in)))))
                       )
                     )
                   )
                 )
               )
           )
         )
          (setq lst (cons nm lst))
       )
     )
     (setvar 'cmdecho 0)
     (foreach e lst
       (if (and (setq p (vlax-invoke
                          obj
                          'IntersectWith
                          (vlax-ename->vla-object e)
                          acExtendNone
                        )
                )
                (> (distance (dxf 10 e) (dxf 11 e)) (* of 2.))
           )
         (command "_.break"
                  e
                  "_none"
                  (vlax-curve-getclosestpointto
                    e
                    (polar p (angle (dxf 10 e) (dxf 11 e)) of)
                  )
                  "_none"
                  (vlax-curve-getclosestpointto
                    e
                    (polar p (angle (dxf 11 e) (dxf 10 e)) of)
                  )
         )
       )
     )
     (setvar 'cmdecho 1)
   )
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)
(vl-load-com)

(defun c:demo (/ s ss space  pntlst TempL p p1 p2)
 (vl-load-com)
 (setq space (vlax-get
               (vla-get-ActiveLayout
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 )
               )
               'Block
             )
 )
 (if (and (setq s (ssget "_+.:S:L" '((0 . "[b]MULTILEADER[/b]"))))
          (setq s (vlax-ename->vla-object (ssname s 0)))          
        (setq width (cond
        ((getdist (strcat "\nEnter width "
         (if width (strcat " <" (rtos width) ">: ") ": ")
                    )))(width))
        )
          (setq w (* 0.5 width))
     )
   (progn
     (setq pntlst (vlax-invoke
                    s 'GetLeaderLineVertices  0
                  )
           zv     (nth 2 pntlst)
     )
     (setq TempL
            (vlax-invoke
              space
              'AddLightweightPolyline
              (vl-remove-if '(lambda (l) (= zv l)) pntlst)
            ))
     (setq ss (ssget "_:L"))
       (repeat (setq i (sslength ss))
         (if (setq p (vlax-invoke
                       TempL
                       'IntersectWith
                       (setq
                         e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
                       )
                       acExtendNone
                     )
             )
           (progn
             (setq p1 (vlax-curve-getpointatDist
                        e (- (vlax-curve-getDistAtPoint e p) w))
                   p2 (vlax-curve-getpointatDist  e
                        (+ (vlax-curve-getDistAtPoint e p) w)
                      )
             )
             (command "_break" (ssname ss i) "_non" p1 "_non" p2)
           )
         )
       )
     (vla-delete TempL)
   )
 )(princ)
)

(defun c:test ( / s ss width)
 (if (and (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
          (setq s  (vlax-ename->vla-object (ssname s 0))
                ss (ssadd)
          )
          (setq width (getdist "\nEnter width: "))
     )
   (progn
     (vlax-invoke s 'offset (- (* 0.5 width)))
     (ssadd (entlast) ss)
     (vlax-invoke s 'offset (* 0.5 width))
     (ssadd (entlast) ss)
     (command "_trim" ss
              ""  "_Fence"  "_non"
              (vlax-get s 'StartPoint)
              "_non" (vlax-get s 'EndPoint)
              ""
     )
     (command "_erase" ss "" "")
   )
 )(
   princ)
)

(defun c:demo (/ s s1 ss space pntlst w pntlst zv TempL TempL1 TempL2 Lv L1v L2v )
   (vl-load-com)
   (setq space (vlax-get
               (vla-get-ActiveLayout
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 )
               )
               'Block
             )
 )
 (if (and
         (princ "\nSelect MLeader")
         (setq s (ssget "_+.:S:L" '((0 . "MULTILEADER"))))
         (setq s (vlax-ename->vla-object (setq s1 (ssname s 0))))     
         (setq width (cond
 ((getdist (strcat "\nEnter width "
  (if width (strcat " <" (rtos width) ">: ") ": ")
             )))(width))
 )
          (setq w (* 0.5 width))
     )
     (progn
         (setq pntlst (vlax-invoke
                          s 'GetLeaderLineVertices  0
                      )
               zv     (nth 2 pntlst)
         )
         (setq TempL
                  (vlax-invoke
                      space
                      'AddLightweightPolyline
                      (vl-remove-if '(lambda (l) (= zv l)) pntlst)
                  )
         )
         (vlax-invoke TempL 'offset (- (* 0.5 width)))
         (setq TempL1 (entlast))
         (vlax-invoke TempL 'offset (* 0.5 width))
         (setq TempL2 (entlast))
         (setq
             Lv1 (coo TempL1)
             Lv2 (coo TempL2)
             Lv (append Lv1 (reverse Lv2))
          )
         (setq os (getvar 'osmode))
         (setvar 'osmode 0)
         (command "_.wipeout")
         (apply 'command Lv)
         (command "")
         (setvar 'osmode os)
         (command "_.draworder" s1 "" "_F")
         (vla-delete TempL)
         (entdel TempL1)
         (entdel TempL2)
     )
 )       
)
(defun Coo ( a / coor)              
   (mapcar '(lambda (x)
                (if (eq (car x) 10)
                    (setq coor (cons (list (cadr x) (caddr x)) coor))
                )
            )
            (entget a)
    )
   coor
)