求输入tt，提示选择圆，选择某一图层的圆后，提示选择某一图层的线，确认后选中所

664571221

求输入tt，提示选择圆，选择某一图层的圆后，提示选择某一图层的线，确认后选中所和这个圆相交的这个图层的线

664571221

664571221 发表于 2023-12-9 09:25
小韩代码

(defun c:tt(/ fx-pline fx-polygonout i lst1 s1 s2 sa ss ss1 ss2 ssa ssunion tc1 tc2 xyp-ss2list)
        (defun xyp-DXF (code ename / ent lst a)
                (if (= (type code) 'LIST)
                        (progn
                                (setq ent        (entget ename)
                                        lst        '()
                                )
                                (foreach a code
                                        (setq lst (cons (list a (cdr (assoc a ent))) lst))
                                )
                                (reverse lst)
                        )
                        (if        (= code -3)
                                (cdr (assoc code (entget ename '("*"))))
                                (cdr (assoc code (entget ename)))
                        )  )
               
        )
        (defun fx-polygonout(s1 n dist / i jd p1 pt ptn r x y)
                (setq
                        pt (xyp-dxf 10 s1)
                        ang (/ (* 2 pi) n)
                        r (+ (xyp-dxf 40 s1) dist)
                        r (/ r (cos (/ ang 2)))       
                        i 0
                        ptn (list (list (+ (car pt) r) (cadr pt) 0.0))
                )
                (repeat
                        (- n 1)
                        (setq
                                i (1+ i)
                                jd (* i ang)
                                y (* r (sin jd))
                                x (* r (cos jd))
                                p1 (xyp-Pt2XY pt x y)
                                ptn (append (list p1) ptn)
                        )
                )
                ptn       
        )
        (defun fx-pline(ptn mode / i)
                (setq osm (getvar "osmode"))
                (setvar "osmode" 0)
                (command "pline")
                (apply 'command  ptn)               
                (if (= mode t) (command "c") (command ""))       
                (setvar "osmode" osm)
        )
        (defun SsUnion (ss1 ss2)
                (command "select" ss1 ss2"")
                (ssget "p")
        )
        (defun xyp-ss2list ( ss / i l )
                (if ss
                        (repeat (setq i (sslength ss))
                                (setq l (cons (ssname ss (setq i (1- i))) l))
                        )
                )
        )
        (command "-VIEW" "s" "起始视图")
        (setq
                s1 (car (entsel "\n选择样板圆"))
                tc1 (cdr (assoc 8 (entget s1)))
                s2 (car (entsel "\n选择样板线"))
                tc2 (cdr (assoc 8 (entget s2)))
        )
        (command "zoom" "e")
        (setq
                ss1 (ssget "x" (list (cons 0 "circle") (cons 8 tc1)))
                lst1 (xyp-ss2list ss1)
                ss (ssadd)
                i -1
        )
        (while (setq sa (nth (setq i (1+ i)) lst1))
                (setq
                        ssa (ssget "f" (fx-polygonout sa 90 0.5) (list (cons 0 "*line*") (cons 8 tc2)))
                        ss (SsUnion ssa ss)
                )
        )
        (command "-VIEW" "r" "起始视图")
        (sssetfirst nil ss)
)



(defun c:tt1(/ fx-pline fx-polygonout i lay lst1 lsta osm r s0 s0-ss s1 s2 sa ss ss1 ss2 ssa ssunion tc1 tc2 xyp-9pt xyp-ss2list)
        (defun xyp-DXF (code ename / ent lst a)
  (if (= (type code) 'LIST)
    (progn
      (setq ent        (entget ename)
                                lst        '()
      )
      (foreach a code
        (setq lst (cons (list a (cdr (assoc a ent))) lst))
      )
      (reverse lst)
    )
    (if        (= code -3)
      (cdr (assoc code (entget ename '("*"))))
      (cdr (assoc code (entget ename)))
    )  )
       
)
        (defun fx-polygonout(s1 n dist / i jd p1 pt ptn r x y)
                (setq
                        pt (xyp-dxf 10 s1)
                        ang (/ (* 2 pi) n)
                        r (+ (xyp-dxf 40 s1) dist)
                        r (/ r (cos (/ ang 2)))       
                        i 0
                        ptn (list (list (+ (car pt) r) (cadr pt) 0.0))
                )
                (repeat
                        (- n 1)
                        (setq
                                i (1+ i)
                                jd (* i ang)
                                y (* r (sin jd))
                                x (* r (cos jd))
                                p1 (xyp-Pt2XY pt x y)
                                ptn (append (list p1) ptn)
                        )
                )
                ptn       
        )
        (defun xyp-Pt2XY(pt x y)
                (setq pt (list (+ (car pt) x) (+ (cadr pt) y)))
        )
        (defun xyp-SselEntnext (s0 / ss)
                (setq ss (ssadd))
                (while (setq s0 (entnext s0))
                        (setq ss (ssadd s0 ss))
                )
                (if (/= (sslength ss) 0)
                        ss
                )
        )
        (defun xyp-9Pt (ss site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8)               
                (defun mid (p1 p2)(mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))
                (defun zdwkgj(ss / i m n o)
                        (if (= (type ss) 'ENAME) (setq ssa nil ssa (ssadd) ssa (ssadd ss ssa) ss ssa))               
                        (repeat (setq i (sslength ss))
                                (if
                                        (and
                                                (setq o (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
                                                (vlax-method-applicable-p o 'getboundingbox)
                                                (not
                                                        (vl-catch-all-error-p
                                                                (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))
                                                        )
                                                )
                                        )
                                        (setq
                                                m (cons (vlax-safearray->list a) m)
                                                n (cons (vlax-safearray->list b) n)
                                        )
                                )
                        )
                        (if (and m n)
                                (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                                        '(min max)                               
                                        (list m n)
                                )
                        )
                )               
                (setq
                        p1 (car (zdwkgj ss))               
                        p9 (cadr (zdwkgj ss))                       
                        p5 (mid p1 p9)                       
                        p3 (if (< (car p9) (car p1))                                         
                                         (list (car p1) (cadr p9) (caddr p1))                                         
                                         (list (car p9) (cadr p1) (caddr p1))                                         
                                 )                       
                        p7 (if (< (car p9) (car p1))                                         
                                         (list (car p9) (cadr p1) (caddr p9))                                         
                                         (list (car p1) (cadr p9) (caddr p9))                                         
                                 )                       
                        p2 (mid p1 p3)                       
                        p4 (mid p1 p7)                       
                        p6 (mid p3 p9)                       
                        p8 (mid p7 p9)                       
                )               
                (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))               
        )
        (defun fx-pline(ptn mode / i)
                (setq osm (getvar "osmode"))
                (setvar "osmode" 0)
                (command "pline")
                (apply 'command  ptn)               
                (if (= mode t) (command "c") (command ""))       
                (setvar "osmode" osm)
        )
        (defun SsUnion (ss1 ss2)
                (command "select" ss1 ss2"")
                (ssget "p")
        )
        (defun xyp-ss2list ( ss / i l )
                (if ss
                        (repeat (setq i (sslength ss))
                                (setq l (cons (ssname ss (setq i (1- i))) l))
                        )
                )
        )
        (setq lay (getvar "CLAYER") osm (getvar "osmode"))
        (setvar "osmode" 0)
        (command "-VIEW" "s" "起始视图")
        (setq
                s1 (car (entsel "\n选择样板圆块"))
                tc1 (cdr (assoc 8 (entget s1)))
                r (distance (xyp-9pt s1 4) (xyp-9pt s1 5))
                s2 (car (entsel "\n选择样板线"))
                tc2 (cdr (assoc 8 (entget s2)))
                )
        (command "zoom" "e")
        (setq
                lsta (xyp-ss2list (ssget "x" (list (cons 0 "INSERT") (cons 8 tc1))))
        )
        (setvar "CLAYER" tc1)
        (setq s0 (entlast))
        (mapcar '(lambda (x) (vl-cmdf "circle" (xyp-9pt x 5) r)) lsta)
        (setq
                s0-ss (xyp-SselEntnext s0)       
                ss1 (ssget "x" (list (cons 0 "circle") (cons 8 tc1)))
                lst1 (xyp-ss2list ss1)
                ss (ssadd)
                i -1
        )
        (while (setq sa (nth (setq i (1+ i)) lst1))
                (setq
                        ssa (ssget "f" (fx-polygonout sa 90 0.5) (list (cons 0 "*line*") (cons 8 tc2)))
                        ss (SsUnion ssa ss)
                )
        )
        (setvar "CLAYER" lay)
        (setvar "osmode" osm)
        (vl-cmdf "erase" s0-ss "")
        (command "-VIEW" "r" "起始视图")
        (sssetfirst nil ss)
)

韩飞翔

如果是圆则按照这个代码

1. 
   

复制代码

韩飞翔

1. 看下条

复制代码

韩飞翔

如果圆

1. 
   

复制代码

是块，看这个代码

664571221

波总代码(defun c:tt (/ b bb e ee i k la p p1 p3 pt1 pt2 pt3 pt4 r s s1 ss)
        (if (and ;(setq la "PIPE-污水")
                                (setq e (ssget ":E:S" '((0 . "LWP*"))))
                                (setq la (cdr (assoc 8 (entget (ssname e 0)))))
                                (setq s (ssget '((0 . "INS*"))))
                          (setq i -1)
                        )        
                 (progn
                         (setq ss (ssadd))
                         (while (setq e (ssname s (setq i (1+ i))))
                                 (vla-Explode (vlax-ename->vla-object e))                                 
                                 (if (and (setq e (entlast))
                                                         (setq ee (entget e))
                                                         (= "CIRCLE" (cdr (assoc 0 ee)))
                                                         (setq p (cdr (assoc 10 ee))
                                                                 r (+ 1e-3 (cdr (assoc 40 ee)))
                                                                 pt1 (mapcar '- p (list r r))
                                                                 pt2 (mapcar '+ p (list (- r) r))
                                                                 pt3 (mapcar '+ p (list r r))
                                                                 pt4 (mapcar '+ p (list  r (- r)))
                                                                 p1 (mapcar '- pt1 (list r r))
                                                                 p3 (mapcar '+ pt3 (list r r))
                                                         )
                                                         (setq e (vlax-ename->vla-object e))
                                                 )
                                         (progn
                                                 (vla-ZoomWindow (vlax-get-acad-object) (vlax-3D-point p1) (vlax-3D-point p3))
                                                 (if (setq s1 (ssget "CP" (list pt1 pt2 pt3 pt4 pt1) (list '(0 . "LWPOLY*")(cons 8 la))))
                                                         (progn                                                  
                                                                 (setq k -1)
                                                                 (while (setq b (ssname s1 (setq k (1+ k))))
                                                                         (if (and (not (ssmemb b ss))
                                                                                                 (setq bb (vlax-ename->vla-object b))
                                                                                                 (not
                                                                                                         (vl-catch-all-error-p
                                                                                                                 (vl-catch-all-apply 'vla-IntersectWith (list e bb acExtendNone))
                                                                                                         )
                                                                                                 )
                                                                                         )
                                                                                 (ssadd b ss)
                                                                         )                                                                 
                                                                 )
                                                         )
                                                 )
                                                 (vla-Delete e)
                                                 (if (<= 1 (sslength ss))
                                                         (sssetfirst nil ss)
                                                 )                                                
                                         )                                         
                                 )
                         )
                 )
        )
)

664571221

664571221 发表于 2023-12-9 09:22
波总代码(defun c:tt (/ b bb e ee i k la p p1 p3 pt1 pt2 pt3 pt4 r s s1 ss)
        (if (and ;(setq  ...

小韩代码看最后的