线形换向原码[附图]

yfy2003 · 发表于 2003-11-22 10:31:00

原码： 取出AcDb2dPolyline实体中的点数组，而且将AcDb2dPolyline实体中的点反向 A=(student *)malloc(3000*sizeof(student)); acedSSGet(NULL,NULL,NULL,NULL,ss);//选择实体 acedSSLength(ss,&len); if(acedSSName(ss,0,ent)!=RTNORM) return; AcDbObjectId eId; AcDbObject *pObj; AcDb::Poly2dType type;//拟合类型 AcGePoint2d lp; acdbGetObjectId(eId, ent); acdbOpenObject(pObj, eId, AcDb::kForWrite); if(pObj->isKindOf(AcDbPolyline::desc())) {//AcDbPolyline换向 N=AcDbPolyline::cast(pObj)->numVerts(); for(j=0; j AcDbPolyline::cast(pObj)->getPointAt(j, lp); (A+j)->x=lp[X]; (A+j)->y=lp[Y]; } kv=N; for(j=0;j kv=kv-1; lp[X]=(A+kv)->x; lp[Y]=(A+kv)->y; AcDbPolyline::cast(pObj)->setPointAt(j, lp); } pObj->close(); }else if(pObj->isKindOf(AcDb2dPolyline::desc())) {//AcDb2dPolyline换向 AcDb2dPolyline *pPline; acdbOpenObject(pPline, eId, AcDb::kForRead); type=pPline->polyType();//拟合类型 pPline->close(); acdbOpenObject(pPline,eId,AcDb::kForWrite); pPline->convertToPolyType(AcDb::k2dSimplePoly);//改成不拟合 pPline->close(); acdbOpenObject(pPline,eId,AcDb::kForRead); AcDbObjectIterator *pVertIter=pPline->vertexIterator(); AcDb2dVertex *pVertex; AcGePoint3d location; AcDbObjectId vertexObjId; N=0; for(j=0;!pVertIter->done();j++,pVertIter->step()) {//遍历坐标 vertexObjId=pVertIter->objectId(); acdbOpenObject(pVertex,vertexObjId,AcDb::kForRead); location = pVertex->position(); N=N+1; (A+N)->x=location[X]; (A+N)->y=location[Y]; (A+N)->z=location[Z]; pVertex->close(); } delete pVertIter; pPline->close(); acdbOpenObject(pPline,eId,AcDb::kForRead); AcDbObjectIterator *pVertIter1=pPline->vertexIterator(); for(j=0;!pVertIter->done();j++,pVertIter->step()) { vertexObjId = pVertIter->objectId(); acdbOpenObject(pVertex, vertexObjId,AcDb::kForWrite); location[X]=(A+N)->x; location[Y]=(A+N)->y; location[Z]=(A+N)->z; pVertex->setPosition(location); pVertex->close(); N=N-1; } delete pVertIter1; pPline->close(); acdbOpenObject(pPline,eId,AcDb::kForWrite); if(type==0)//还原拟合类型 pPline->convertToPolyType(AcDb::k2dSimplePoly); else if(type==1) pPline->convertToPolyType(AcDb::k2dFitCurvePoly); else if(type==2) pPline->convertToPolyType(AcDb::k2dQuadSplinePoly); else if(type==3) pPline->convertToPolyType(AcDb::k2dCubicSplinePoly); pPline->close(); pObj->close(); } acedSSFree(ss); free(A);

guankuiwu · 发表于 2021-1-9 23:26:05

收藏下了，多谢分享

guankuiwu · 发表于 2019-12-12 11:02:08

曲线走向会变的！

lockmyeye · 发表于 2003-11-22 12:48:00

;;;LWPOLYLINE线型换向，不能对POLYLINE线型换向，拟合过的线条都是POLYLINE线。
(DEFUN c:lwpolyline_reverse (/ ss1 num data one points tempnum tempent)
(PRINC "\n\t请选择要换向的线条:")
(SETQ ss1 (SSGET (LIST (CONS 0 "lwpolyline"))))
(SETQ num 0)
(REPEAT (IF ss1
(SSLENGTH ss1)
0
)
(SETQ data (ENTGET (SSNAME ss1 num))
num (1+ num)
)
(SETQ points nil)
(FOREACH one data
(PROGN (IF (= (CAR one) 10)
(SETQ points (APPEND points (LIST one)))
)
)
)
(SETQ points (REVERSE points))
(SETQ tempnum 0)
(SETQ tempent nil)
(FOREACH one data
(PROGN (IF (= (CAR one) 10)
(SETQ tempent (APPEND tempent (LIST (NTH tempnum points)))
tempnum (1+ tempnum)
)
(SETQ tempent (APPEND tempent (LIST one)))
)
)
)
(IF (NOT (ENTMOD tempent))
(ALERT "错误:\n\t不能更新实体数据!\t")
)
)
(PRINC)
)

复制代码

yfy2003 · 发表于 2003-11-22 13:22:00

你这是L我只会A，看不懂！

mccad · 发表于 2003-11-22 14:38:00

呵呵，来个VBA的(以前贴过)

Sub RevPline()
Dim ent As AcadEntity
Dim pnt As Variant
Dim NewCoord() As Double
Dim i As Integer
On Error Resume Next
Do
ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："
If Err Then Exit Sub
If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
Loop
Dim Coord As Variant
Dim CoordCount As Integer
Dim Bulge() As Double
If TypeName(ent) = "IAcadLWPolyline" Then
Coord = ent.Coordinates
CoordCount = (UBound(Coord) + 1) / 2
ReDim NewCoord(UBound(Coord)) As Double
For i = 0 To UBound(Coord) - 1 Step 2
NewCoord(UBound(Coord) - i - 1) = Coord(i)
NewCoord(UBound(Coord) - i) = Coord(i + 1)
Next
ReDim Bulge(CoordCount - 1) As Double
For i = 0 To CoordCount - 1
Bulge(i) = ent.GetBulge(i)
Next
ent.Coordinates = NewCoord
For i = 0 To CoordCount - 2
ent.SetBulge i, -Bulge(CoordCount - 2 - i)
Next
ThisDrawing.Regen acActiveViewport
ElseIf TypeName(ent) = "IAcadPolyline" Then
Coord = ent.Coordinates
CoordCount = (UBound(Coord) + 1) / 3
ReDim NewCoord(UBound(Coord)) As Double
For i = 0 To UBound(Coord) - 1 Step 3
NewCoord(UBound(Coord) - i - 2) = Coord(i)
NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)
NewCoord(UBound(Coord) - i) = Coord(i + 2)
Next
If ent.Type = acSimplePoly Then
ReDim Bulge(CoordCount - 1) As Double
For i = 0 To CoordCount - 1
Bulge(i) = ent.GetBulge(i)
Next
End If
ent.Coordinates = NewCoord
If ent.Type = acSimplePoly Then
For i = 0 To CoordCount - 2
ent.SetBulge i, -Bulge(CoordCount - 2 - i)
Next
End If
ThisDrawing.Regen acActiveViewport
End If
End Sub

Sub RevPline() 
    Dim ent As AcadEntity 
    Dim pnt As Variant 
    Dim NewCoord() As Double 
    Dim i As Integer 
    On Error Resume Next 
    Do 
        ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线：" 
        If Err Then Exit Sub 
        If TypeName(ent) Like "IAcad*Polyline" Then Exit Do 
    Loop 
    Dim Coord As Variant 
    Dim CoordCount As Integer 
    Dim Bulge() As Double 
    If TypeName(ent) = "IAcadLWPolyline" Then 
        Coord = ent.Coordinates 
        CoordCount = (UBound(Coord) + 1) / 2 
        ReDim NewCoord(UBound(Coord)) As Double 
        For i = 0 To UBound(Coord) - 1 Step 2 
            NewCoord(UBound(Coord) - i - 1) = Coord(i) 
            NewCoord(UBound(Coord) - i) = Coord(i + 1) 
        Next 
        ReDim Bulge(CoordCount - 1) As Double 
        For i = 0 To CoordCount - 1 
            Bulge(i) = ent.GetBulge(i) 
        Next 
        ent.Coordinates = NewCoord 
        For i = 0 To CoordCount - 2 
            ent.SetBulge i, -Bulge(CoordCount - 2 - i) 
        Next 
        ThisDrawing.Regen acActiveViewport 
    ElseIf TypeName(ent) = "IAcadPolyline" Then 
        Coord = ent.Coordinates 
        CoordCount = (UBound(Coord) + 1) / 3 
        ReDim NewCoord(UBound(Coord)) As Double 
        For i = 0 To UBound(Coord) - 1 Step 3 
            NewCoord(UBound(Coord) - i - 2) = Coord(i) 
            NewCoord(UBound(Coord) - i - 1) = Coord(i + 1) 
            NewCoord(UBound(Coord) - i) = Coord(i + 2) 
        Next 
        If ent.Type = acSimplePoly Then 
            ReDim Bulge(CoordCount - 1) As Double 
            For i = 0 To CoordCount - 1 
                Bulge(i) = ent.GetBulge(i) 
            Next 
        End If 
        ent.Coordinates = NewCoord 
        If ent.Type = acSimplePoly Then 
            For i = 0 To CoordCount - 2 
                ent.SetBulge i, -Bulge(CoordCount - 2 - i) 
            Next 
        End If 
       ThisDrawing.Regen acActiveViewport 
    End If 
    
End Sub

yfy2003 · 发表于 2003-11-22 14:41:00

VBA的能看懂！

今晚打老虎 · 发表于 2003-12-3 09:47:00

算法应该是一样的吧~~~~~

xbbcad · 发表于 2003-12-3 15:01:00

把lockmyeye的程序参考进去了，不敢独享，贴上来供诸位高手拍砖

;DDL: Copyright By WWZ,2003-12-3
;颠倒直线的两端点,即交换实体对象组代码10和11，
;用于解决直线、dimension、多段线的线型换向问题

(defun C:ddl(/ tmp ed ent m n endpt1 endpt2 newline name)
(princ "\n交换直线、多段线或标注的起点和终点.请选择直线、多段线或标注:\n")
;选择直线或标注，注意逻辑组的使用
(setq tmp (ssget (list (cons -4 " (if tmp
   (progn
     (setq n (sslength tmp) m 0)
     (repeat n
         (setq ent (ssname tmp m))
         (setq ed (entget ent))
         ;(ts "\nent=")
         ;(ts ent)
         (setq name (cdr (assoc 0 ed)))
         (if (= name "LWPOLYLINE")
           (lwpolyline_reverse ent ed)
           (progn
             (setq endpt1 (cons 11 (cdr (assoc 10 ed) )))
             (setq endpt2 (cons 10 (cdr (assoc 11 ed) )))
             (setq ed (subst endpt1 (assoc 11 ed) ed))
             (setq ed (subst endpt2 (assoc 10 ed) ed))
             (setq newline ed)
             ;删除原对象并生成相同句柄的新对象，注意：
             ;enddel 对象名称ent不是对象数据表ed
             ;endmod entmake 的不是对象名称ent是对象数据表ed
             (entdel ent)
             (entmake newline)
          )
         );end if
         (setq m (1+ m))
     );end repeat
   )
);end if tmp
(princ "\n共处理了")
(if m (princ m) (princ "0"))
(princ "条直线(多段线、标注)。")
(princ)

);end C:ddl

;---------------------------------------------------------------------------
;多段线的换向程序,修改自明经通道
(DEFUN lwpolyline_reverse (lwpent data / num data one points tempnum tempent)

       (SETQ points nil)
       (FOREACH one data
            (PROGN (IF (= (CAR one) 10)
                       (SETQ points (APPEND points (LIST one)))
                   )
            )
        )

        (SETQ points (REVERSE points))
        (SETQ tempnum 0)
        (SETQ tempent nil)

        (FOREACH one data
            (PROGN (IF (= (CAR one) 10)
                       (SETQ tempent (APPEND tempent (LIST (NTH tempnum points)))
                             tempnum (1+ tempnum)
                       )
                       (SETQ tempent (APPEND tempent (LIST one)))
                   )
            )
        )
        (entdel lwpent)
        (entmake tempent)

        (PRINC)
);end lwpolyline_reverse

topirol · 发表于 2003-12-16 10:17:00

好像没有考虑到

spline，或者圆弧之类的反向

myfreemind · 发表于 2003-12-16 19:57:00

明总那个我用了，特别的方便！

yybu · 发表于 2004-1-2 14:39:00

插有文字的圆弧(向上凸)文字都是上下颠倒的!换向也不能解决!各位有何高招?

账号		自动登录	找回密码
密码			注册

线形换向原码[附图]

本帖子中包含更多资源

今天正好碰到线型换向的问题