[编程交流] 请给我一些帮助-怎么可能

;; Test Program  -  Lee Mac
;;;(defun c:interset ( / sel )
;;;    (if (setq sel (ssget))
;;;        (foreach pnt (LM:intersectionsinset sel)
;;;            (entmake (list '(0 . "POINT") (cons 10 pnt)))
;;;        )
;;;    )
;;;    (princ)
;;
;;;(vl-load-com) (princ)
(defun c:interset (/ sel)
 (setvar "cmdecho" 0)
 (setq cc1 (ssget "_X" '((0 . "CIRCLE"))))
 (command "-insert" "*clover chain.dwg" pause 1 "")
 (setq circle (ssname cc1 0))
 (setq rad (cdr (assoc 40 (entget circle))))
 (setq newrad (/ rad 0.5))
 (setq sel (ssget "X" '((0 . "CIRCLE,LINE") (8 . "daisy chain"))))
 (LM:intersectionsinset2 sel)
 (command "._erase" (ssget "X" '((0 . "LINE") (8 . "daisy chain"))) "")
 (setq z 0)
 (setq ss (ssget "X" '((0 . "CIRCLE") (8 . "daisy chain"))))
 (repeat (sslength ss)
   (setq ename (ssname ss z)
  circen (cons (list (cdr (assoc 10 (entget ename)))) circen)
  z (1+ z)
   )    
 )
 (setq circen (reverse circen))
 (setq cpt1 (nth 0 (nth 0 circen)))
 (setq cpt2 (nth 0 (nth 1 circen)))
 (setq cpt3 (nth 0 (nth 2 circen)))
 (setq cpt4 (nth 0 (nth 3 circen)))
 (setq dist (distance cpt1 cpt2))
 (setq stretchdist (/ (- (- dist (* 2 rad)) 1) 2))
 (setq cpt1move (strcat "@" (rtos stretchdist) "," (rtos stretchdist)))
 (setq cpt2move (strcat "@" (rtos (- stretchdist)) "," (rtos stretchdist)))
 (setq cpt3move (strcat "@" (rtos stretchdist) "," (rtos (- stretchdist))))
 (setq cpt4move (strcat "@" (rtos (- stretchdist)) "," (rtos (- stretchdist))))
 (setq atomx (nth 0 cpt1))
 (setq atomy (nth 1 cpt1))
 (setq cpt1x (+ (- rad) atomx))
 (setq cpt1y (+ (- rad) atomy))
 (setq ll (list cpt1x cpt1y))
 (setq cpt1x (+ rad atomx))
 (setq cpt1y (+ rad atomy))
 (setq ur (list cpt1x cpt1y))
 (command "stretch" "C" ll ur "" cpt1 cpt1move)
 (setq atomx (nth 0 cpt2))
 (setq atomy (nth 1 cpt2))
 (setq cpt2x (+ (- rad) atomx))
 (setq cpt2y (+ (- rad) atomy))
 (setq ll (list cpt2x cpt2y))
 (setq cpt2x (+ rad atomx))
 (setq cpt2y (+ rad atomy))
 (setq ur (list cpt2x cpt2y))
 (command "stretch" "C" ll ur "" cpt2 cpt2move)
 (setq atomx (nth 0 cpt3))
 (setq atomy (nth 1 cpt3))
 (setq cpt3x (+ (- rad) atomx))
 (setq cpt3y (+ (- rad) atomy))
 (setq ll (list cpt3x cpt3y))
 (setq cpt3x (+ rad atomx))
 (setq cpt3y (+ rad atomy))
 (setq ur (list cpt3x cpt3y))
 (command "stretch" "C" ll ur "" cpt3 cpt3move)
 (setq atomx (nth 0 cpt4))
 (setq atomy (nth 1 cpt4))
 (setq cpt4x (+ (- rad) atomx))
 (setq cpt4y (+ (- rad) atomy))
 (setq ll (list cpt4x cpt4y))
 (setq cpt4x (+ rad atomx))
 (setq cpt4y (+ rad atomy))
 (setq ur (list cpt4x cpt4y))
 (command "stretch" "C" ll ur "" cpt4 cpt4move)
 (setvar "cmdecho" 1)
 (princ)
)
(vl-load-com)
(princ)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections        (ob1 ob2 mod / lst rtn int)
 (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
 (repeat (/ (length lst) 3)
   (setq rtn (cons (list (car lst)
                  (cadr lst)
                  (caddr lst)
            )
            rtn
      )
  int (vlax-3d-point lst)
   )
   (vla-ScaleEntity ob1 int newrad)
 )
)

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set
(defun LM:intersectionsinset2 (sel / id1 id2 ob1 ob2 rtn)
 (repeat (setq id1 (sslength sel))
   (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
   (if        (= (setq ob1type (vla-get-ObjectName ob1)) "AcDbLine")
     (princ)
     (progn
(setq sslist (cons (ssname sel id1) sslist))
(repeat        (setq id2 id1)
  (setq        ob2 (vlax-ename->vla-object
              (ssname sel (setq id2 (1- id2)))
            )
  )
  (if (= (setq ob2type (vla-get-ObjectName ob2)) "AcDbCircle")
    (princ)
    (LM:intersections ob1 ob2 acextendnone)
  )                                ;end if
)                                ;end repeat
     )                                        ;progn
   )                                        ;end if
 )                                        ;end repeat
                                ;(apply 'append (reverse rtn))  
)