社区 › Auto Lisp › 圆角线和/或PLINE

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

圆角线和/或PLINE

你好
 
 
我试图得到一段代码，它能够以给定的半径圆角，无论它是直线的多段线。我得到了这个常规钢筋弯曲工作，但它只适用于线。我也想让它“多段线友好”。
 
 
这是一段代码。我陷入了决定t是直线还是多段线的部分。如有任何帮助或导致类似代码，我们将不胜感激。
 
 



; 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
         CMDDIA0
         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

尝试：
 
(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。
(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

也许是这样：
(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