社区 › Auto Lisp › 弧到弦

BIGAL 发表于 2022-7-6 17:09:14

弧到弦

有人用lisp或vba将圆弧转换为一系列和弦吗。用户将指定每个弧的和弦数。
 
只是急需

Strix 发表于 2022-7-6 17:26:24

这些事情你需要做多少？
 
如果情况紧急，是否可以使用“DIVIDE”或“MEASURE”沿弧生成比所需弦多一个节点，然后使用节点对象捕捉打开的线条连接节点？

BIGAL 发表于 2022-7-6 17:39:39

需要做100个，因此只要找到所有的弧，并这样做，无论弧是否大小不同。

ASMI 发表于 2022-7-6 17:49:52

对于多个圆弧、圆、椭圆、多段线和样条曲线（任何AutoCAD曲线）：
 
(defun c:CurvesToSegments(/ cSet sLen cLen sDis ptLst oOsn
                  eLst cAns vCnt lPt)

(vl-load-com)

(princ "<<< Select curves to transform >>>")
(if
   (setq cSet
   (ssget
          '((0 . "*POLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
   (if(setq sLen(getdist "\nSpecify segment lentgth: "))
   (progn
(setq oOsn(getvar "OSMODE"))
(setvar "CMDECHO" 0)(setvar "OSMODE" 0)
       (foreach itm(setq eLst(vl-remove-if 'listp
                      (mapcar 'cadr(ssnamex cSet))))
(setq sDis 0.0
      cLen(-(vlax-curve-getDistAtParam itm
              (vlax-curve-getEndParam itm))
          (vlax-curve-getDistAtParam itm
              (vlax-curve-getStartParam itm)))
          ); end setq
(if(= "LWPOLYLINE"(cdr(assoc 0(entget itm))))
(progn
(setq vCnt 1
        ptLst(list(vlax-curve-GetPointAtDist itm sDis)))
   (while(and
           (<= sDis cLen)
           (vlax-curve-GetPointAtParam itm vCnt)
           (setq cPt(vlax-curve-GetPointAtDist itm sDis))
           ); end and
      (if(= 0.0(vla-GetBulge(vlax-ename->vla-object itm)(1- vCnt)))
        (setq ptLst(append ptLst
                (list(vlax-curve-GetPointAtParam itm vCnt)))
              sDis(vlax-curve-GetDistAtParam itm vCnt)
              ); end setq
        (progn
          (while(<= sDis(vlax-curve-GetDistAtParam itm vCnt))
          (setq cPt(vlax-curve-GetPointAtDist itm sDis)
                  ptLst(append ptLst(list cPt))
                  sDis(+ sDis sLen))
          ); end while
          (setq ptLst(append ptLst
                (list(vlax-curve-GetPointAtParam itm vCnt))))
          ); end progn
        ); end if
      (setq vCnt(1+ vCnt))
   ); end while
); end progn
   (while(and
           (<= sDis cLen)
           (setq cPt(vlax-curve-GetPointAtDist itm sDis))
           ); end and
   (setq ptLst(append ptLst(list cPt))
           sDis(+ sDis sLen))
   ); end while
); end if
(if(not(equal(setq lPt(vlax-curve-getEndPoint itm))(last ptLst)))
    (setq ptLst(append ptLst(list lPt)))
   ); end if
(command "_.pline")(mapcar 'command ptLst)(command "")
(setq ptLst nil)
      ); end foreach
(initget "Yes No")
(setq cAns(getkword "\nRemove old curves <Yes>: "))
(if(or(null cAns)(= cAns "Yes"))
(mapcar 'entdel eLst)
); end foreach
      (setvar "CMDECHO" 1)(setvar "OSMODE" oOsn)
   ); end progn
    ); end if
   ); end if
(princ)
); end of c:CurvesToSegments

lpseifert 发表于 2022-7-6 18:08:51

非常感谢，我今天将测试它们。

BIGAL 发表于 2022-7-6 18:17:00

查看完整版本: 弧到弦