社区 › Auto Lisp › 多段线曲线设置为零ra

eldon 发表于 2022-7-5 23:02:20

也许您可以手动完成，但需要使用另一种技术。
 
首先分解多段线。然后删除所有弧段。然后使用Pedit和适当的模糊距离，重新连接所有直线段以形成多段线。

Stefan BMR 发表于 2022-7-5 23:04:57

(defun c:test (/ ss r i)
(if
   (setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))
    (progn
      (if
      (setq r (getdist (strcat "\nFillet radius <" (rtos (getvar 'filletrad)) ">: ")))
         (setvar 'filletrad (abs r))
      )
      (repeat (setq i (sslength ss))
      (command "fillet" "p" (ssname ss (setq i (1- i))))
      )
    )
)
(princ)
)

rrulep 发表于 2022-7-5 23:06:31

你好
 
这是我写的，但我想修剪重叠在白线上的红线，只显示延伸到曲线外的红线。
 
(defun c:pol ()
(if (not (tblsearch "LAYER" "C-ROAD_CURV_TAN"))
   (entmake '((0 . "LAYER")
      (100 . "AcDbSymbolTableRecord")
      (100 . "AcDbLayerTableRecord")
      (2 . "C-ROAD_CURV_TAN")
      (70 . 0)
      (62 . 10)
      (370 . -3)
      (6 . "Continuous")
       )
   )
)


(setq poly (ssget '((0 . "LWPOLYLINE"))))
(command "copy" poly"" "0,0" "0,0" "")
(setq poly2 (entlast))
(command "CHANGE" poly2 "" "P" "la" "C-ROAD_CURV_TAN" "")

(setvar "FILLETRAD" 0.0)

(command "fillet" "p" poly2 "")


(princ)
)

Lee Mac 发表于 2022-7-5 23:11:28

还有一种方法：

(defun c:decurve ( / vertexdata b c e i l p q r s x )

   (defun vertexdata ( e )
       (if (setq e (member (assoc 10 e) e))
         (cons (list (cdr (assoc 10 e)) (cdr (assoc 42 e))) (vertexdata (cdr e)))
       )
   )
   (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "<>") (42 . 0.0))))
       (repeat (setq i (sslength s))
         (setq e (entget (ssname s (setq i (1- i))))
               l (vertexdata e)
               r nil
         )
         (if (setq c (= 1 (logand 1 (cdr (assoc 70 e)))))
               (setq l (append l (list (car l))))
         )
         (while (cadr l)
               (if
                   (and (/= 0.0 (setq b (cadar l)))                        
                     (setq p
                           (polar (caar l)
                               (+ (angle (caar l) (caadr l)) (- (/ pi 2) (* 2 (atan b))))
                               (/ (* (distance (caar l) (caadr l)) (1+ (* b b))) 4 b)
                           )
                     )
                     (setq q
                           (inters
                               (caarl) (polar (caarl) (+ (angle p (caarl)) (/ pi 2.0)) 1.0)
                               (caadr l) (polar (caadr l) (+ (angle p (caadr l)) (/ pi 2.0)) 1.0)
                               nil
                           )
                     )
                   )
                   (setq r (vl-list* q (caar l) r))
                   (setq r (cons (caar l) r))
               )
               (setq l (cdr l))
         )
         (if (not c) (setq r (cons (caar l) r)))
         (entmake
               (append
                   (subst
                     (cons90 (length r))
                     (assoc 90 e)
                     (reverse (member (assoc 39 e) (reverse e)))
                   )
                   (mapcar '(lambda ( x ) (cons 10 x)) (reverse r))
                   (list (assoc 210 e))
               )
         )
       )
   )
   (princ)
)
(princ)

GP_ 发表于 2022-7-5 23:15:45

 
 
..... .....

Lee Mac 发表于 2022-7-5 23:18:21

..........

rrulep 发表于 2022-7-5 23:23:02

 
嗨，李
 
你的版本比我的快得多。
是否可以仅绘制弧外的线或删除重叠在原始多段线上的线？

Lee Mac 发表于 2022-7-5 23:23:49

 
太好了，谢谢
 
 
该程序将在删除所有圆弧段并替换为直线段的情况下重新创建多段线，因此，如果需要，可以删除原始多段线（或者可以轻松地将此删除添加到代码中）。
 
李

rrulep 发表于 2022-7-5 23:28:52

嗨，李
 
我只想删除与原始多段线重叠的直线

查看完整版本: 多段线曲线设置为零ra