各位大侠看下，这里有个线延伸到圆心的程序，如何改成批量的不出错

664571221

各位大侠看下，这里有个线延伸到圆心的程序，如何改成批量的不出错，这个LX2选一个线和圆能延伸到圆心，批量选就会出错，附上测试图纸和出错的截图

ssyfeng

这种直接修改多段线的端点就好了，不要用延伸命令，那个命令容易出错

664571221

ssyfeng 发表于 2024-12-17 09:17
这种直接修改多段线的端点就好了，不要用延伸命令，那个命令容易出错

大哥可以搞一个不

xyp1964

664571221

xyp1964 发表于 2024-12-17 11:29

w先生说明：曲线延伸到圆心【默认曲线是过圆心的】
(defun C:tt(/ ptn pts r1 s2 s3lst ss ss2 ss2lst)
    (xyp-start)
    (while (setq ss (ssget '((0 . "CIRCLE"))))
        (foreach s1 (xyp-ss2List ss)
            (setq r1 (xyp-dxf 40 s1));记录最初半斤
            (xyp-Polygon 10 (+ r1 20) (xyp-dxf 10 s1));;正多边形
            (setq s2 (entlast));;正多边形
            (setq ptn (xyp-Vertexs  s2 0))
            (setq ss2 (ssget "f" ptn '((0 . "LWPOLYLINE"))))
            (setq ss2lst (vl-remove s2 (xyp-ss2List ss2)))
            (foreach s3 ss2lst
                (setq pts (car(xyp-Inters s2 s3 0)))
                (setq s3lst (list s3 pts))
                (xyp-ExtendCircelCenter s3lst 10)
            )
            (xyp-Erase s2)
        )        
    )
    (xyp-End)
)

664571221

波总
(defun c:tt (/ e ee i l m p p1 p2 p3 p4 pp pt r s s1)
    (if (setq s (ssget '((0 . "CIRCLE")(8 . "VPIPE-消防"))))
        (progn
            (setq i -1)
            (while (setq e (ssname s (setq i (1+ i))))
                (setq ee (entget e)
                    p(cdr (assoc 10 ee))
                    r (1+ (cdr (assoc 40 ee)))
                    p1 (mapcar '- p (list r r 0))
                    p2 (mapcar '+ p (list r (- r) 0))
                    p3 (mapcar '+ p (list r r 0))
                    p4 (mapcar '+ p (list (- r) r 0))
                )                                
                (if (setq s1 (ssget "F" (list p1 p2 p3 p4 p1) '((0 . "LWPOLYLINE")(8 . "PIPE-消防"))))
                    (progn
                        (setq m -1)
                        (while (setq l (ssname s1 (setq m (1+ m))))
                            (setq ee (entget l))
                            (setq pp (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))ee)))
                            (setq pt (car (vl-sort (list (car pp) (last pp))'(lambda(a b)(< (distance a p)(distance b p))))))
                            (entmod (subst (cons 10 p) (cons 10 pt) ee))
                        )
                    )
                )
            )
        )
    )
    (princ)
)

xj6019

(defun c:NM (/ i info mo ns10 ns11 obj s s10 s11 ss ssa)
        (setq ss(ssget '((0 . "LWPOLYLINE,line"))))
        (setvar 'cmdecho 0)
        (command "_.undo" "be")
        (setq s(sslength ss))
        (setq i 0)
        (repeat s
                (setq ssa (ssname ss i))
                (setq obj (vlax-ename->vla-object ssa))
                (setq info (entget ssa))
                (if (= "LINE" (cdr(assoc 0 info)))
                        (setq mo 1)
                        (setq mo 2)
                )
                (setq s10 (vlax-curve-getStartPoint obj))
               
                (if (and (setq ns10(osnap  s10 "center"))
                                        (<(distance s10  ns10)51)
                                )
                        (progn
                                (setq ns10 (cons 10 (mapcar '* '(1.0 1.0)ns10) ))
                                (setq info (subst ns10 (if (= 2 mo)(cons 10 (mapcar '* '(1.0 1.0)s10))(cons 10 s10)) info))
                                (entmod info)))
                (setq s11 (vlax-curve-getendPoint obj))
                (print s11)
               
                (if (and
                                        (setq ns11(osnap  s11 "center"))
                                        (<(distance ns11  s11)51)
                                )
                        (progn
                                (setq ns11 (cons (if (= 2 mo)10 11) (mapcar '* '(1.0 1.0)ns11) ))
                                (setq info (subst ns11 (if (= 2 mo)(cons 10 (mapcar '* '(1.0 1.0)s11))(cons 11 s11)) info))
                                (entmod info)))
                (setq i(1+ i))
        )
        (command "_.undo" "e")
        (setvar 'cmdecho 1)
        (prin1)       
)

664571221

xj6019 发表于 2024-12-18 12:21
(defun c:NM (/ i info mo ns10 ns11 obj s s10 s11 ss ssa)
        (setq ss(ssget '((0 . "LWPOLYLINE,line")) ...

谢谢大哥...

664571221

664571221 发表于 2024-12-18 14:44
谢谢大哥...

波总加强带块中心
(defun c:tt (/ e ee i l m p p1 p2 p3 p4 pp pt r s s1)
    (if (setq s (ssget '((-4 . "<or")(-4 . "<and")(0 . "CIRCLE")(8 . "VPIPE-废水")(-4 . "and>")(-4 . "<and")(0 . "INSERT")(8 . "EQUIP_地漏")(-4 . "and>")(-4 . "or>"))))
        (progn
            (setq i -1)
            (while (setq e (ssname s (setq i (1+ i))))
                (setq p(cdr (assoc 10 (entget e))))     
                (vla-GetBoundingBox (vlax-ename->vla-object e)'p1 'p3)
                (setq p1 (vlax-safearray->list p1)
                                    p3 (vlax-safearray->list p3)
                                    p2 (list (car p3)(cadr p1) 0)
                                    p4 (list (car p1)(cadr p3) 0)
                                )                           
                (if (setq s1 (ssget "F" (list p1 p2 p3 p4 p1) '((0 . "LWPOLYLINE")(8 . "PIPE-废水"))))
                    (progn
                        (setq m -1)
                        (while (setq l (ssname s1 (setq m (1+ m))))
                            (setq ee (entget l))
                            (setq pp (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))ee)))
                            (setq pt (car (vl-sort (list (car pp) (last pp))'(lambda(a b)(< (distance a p)(distance b p))))))
                            (entmod (subst (cons 10 p) (cons 10 pt) ee))
                        )
                    )
                )
            )
        )
    )
    (princ)
)