圆角线和/或PLINE

halam · 发表于 2022-7-5 15:58:29

你好

我试图得到一段代码，它能够以给定的半径圆角，无论它是直线的多段线。我得到了这个常规钢筋弯曲工作，但它只适用于线。我也想让它“多段线友好”。

这是一段代码。我陷入了决定t是直线还是多段线的部分。如有任何帮助或导致类似代码，我们将不胜感激。

copy


; example for a fixed r=40 handling
(defun c:fg16 (/ CMDECHO CMDDIA FRAD E1 E2)
   (princ "\fillet diam. 16, r = 40 ")
   (setq ERR     *ERROR*
         *ERROR* LISP-ERR
         CMDECHO 0
         CMDDIA  0
         E1      NIL
         E2      NIL
         FRAD    (getvar "filletrad")
   ) ;_ end of setq
   (setvar "filletrad" 40)
   (setq E1 (entsel "\nSelect first object: "))
   (while (/= E1 nil)
       (progn (setq tipoent (cdr (assoc 0 (entget (car (E1))))))  ; hmmm..
                                                           
              (if (= tipoent "POLYLINE")                                    ; if it is ONE polyline , handle it
                  (command "_.fillet" "_polyline" "radius" "40" E1)
                                                                                       ; end for polyline, but it fails (?)
                  (progn (redraw (car E1) 3)                               ; start part for single LINES
                         (setq E2 (entsel "\tsecond: "))                   ; second line needed
                         (redraw (car E2) 3)
                         (command "fillet" E1 E2)
                         (setq E1 (entsel "\nfirst: "))
                  )                              ; end part for single
              )
       )
   )
   (setvar "filletrad" FRAD)
   (princ)
)

Grrr · 发表于 2022-7-5 16:05:52

尝试：

copy

(lambda ( / cmd e typ )
 (setq cmd (cond (command-s)(vl-cmdf)(command))) (setvar 'errno 0)
 (while (zerop (getvar 'errno)) (setq e (car (entsel "\nSelect object to fillet <exit>: ")))
   (cond
     ( (or (not e) (= 7 (getvar 'errno))) (setvar 'errno 0) )
     ( (wcmatch (setq typ (cdr (assoc 0 (entget e)))) "*POLYLINE")
       (cmd "_.fillet" "_polyline" "radius" (vl-prin1-to-string (getvar 'filletrad)) e)
     )
     ( (= typ "LINE") (cmd "fillet" e "\") )
     ( (alert "Invalid object.") )
   )
 )
)

halam · 发表于 2022-7-5 16:12:10

就像冠军一样。。谢谢

Grrr · 发表于 2022-7-5 16:14:27

没问题，汉斯，我很乐意帮忙！

Roy_043 · 发表于 2022-7-5 16:18:15

只是一句话：
为了获得可预测的结果，最好为_Fillet命令提供完整的entsel列表，而不仅仅是ename。

copy

(setq lst (entsel))
(command "_.fillet" lst "\")

Roy_043 · 发表于 2022-7-5 16:22:11

@Grrr：
查看文档，我发现command-s不允许暂停。您的代码表明“\\”（相当于暂停）是。这似乎很奇怪。你测试过这个吗？

Grrr · 发表于 2022-7-5 16:27:54

我不知道你可以提供entsel列表，谢谢！

是的，我已经在ACAD2017上测试了我的片段-效果很好，就像在Hans的演示中一样。

Roy_043 · 发表于 2022-7-5 16:33:28

@Grrr：谢谢你确认这一点。

Roy_043 · 发表于 2022-7-5 16:37:16

@哈拉姆：
如果用户想要圆角两条多段线，该怎么办？当前代码不允许这样做。

Roy_043 · 发表于 2022-7-5 16:43:42

也许是这样：

copy

(vl-load-com)
(defun c:AltFillet ( / *error* N_Radius N_Select doc entselA entselB)
 (defun *error* (msg)
   (setvar 'cmdecho 1)
   (vla-endundomark doc)
 )
 (defun N_Radius ( / new)
   (if (setq new (getdist (strcat "\nFillet radius <" (rtos (getvar 'filletrad)) ">: ")))
     (setvar 'filletrad new)
   )
 )
 (defun N_Select (msg / inp)
   (setq inp T)
   (while (and inp (not (vl-consp inp)))
     (initget 128 "Radius")
     (setq inp
       (entsel
         (strcat
           "\nFillet (radius=" (rtos (getvar 'filletrad)) "):  Radius/<" msg ">: "
         )
       )
     )
     (if (= "Radius" inp)
       (N_Radius)
     )
   )
   inp
 )
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (setvar 'cmdecho 0)
 (cond
   ((not (setq entselA (N_Select "Select first entity")))
     nil
   )
   ((vl-position (vla-get-objectname (vlax-ename->vla-object (car entselA))) '("AcDb2dPolyline" "AcDbPolyline"))
     (if (setq entselB (N_Select "Select second entity or Enter to fillet selected polyline"))
       (command "_.fillet" entselA entselB)
       (command "_.fillet" "_polyline" entselA)
     )
   )
   ((setq entselB (N_Select "Select second entity"))
     (command "_.fillet" entselA entselB)
   )
 )
 (setvar 'cmdecho 1)
 (vla-endundomark doc)
 (princ)
)

[编程交流] 圆角线和/或PLINE

发表回复

精选推荐