学习ARX,编个初组的命令,呵呵

BDYCAD · 发表于 2008-9-27 09:25

本帖最后由作者于 2008-9-27 9:30:47 编辑

//返回椭圆的长半轴和短半轴长度
//编程:包达勇
//2008-09-27 上午9:16
ads_real Dist1,Dist2;
ads_name Ename,Ename1;
ads_point pt,p1,p2;
AcDbObjectId ObjID,NewID;
AcDbEllipse *pEll;
AcGePoint3d Spt,Ept;
if (acedEntSel("\n请您选取要椭圆对象:",Ename,p1)!=RTNORM)return;
if (acdbGetObjectId(ObjID,Ename)!=eOk)return;
acdbOpenObject(pEll,ObjID,AcDb::kForRead);
Spt=(AcGePoint3d&)pEll->minorAxis();
Ept=(AcGePoint3d&)pEll->majorAxis();
pEll->close();
pt[X]=pt[Y]=pt[Z]=0;
ads_point_set(asDblArray(Spt),p1);
ads_point_set(asDblArray(Ept),p2);
Dist1=acutDistance(pt,p1);
Dist2=acutDistance(pt,p2);
acutPrintf("\n报告:\n椭圆的长半轴=%fmm\n椭圆的短半轴=%fmm\n编程:BDYCAD <2008-09-27>",Dist2,Dist1);

复制代码

BDYCAD · 发表于 2008-10-10 16:00

本帖最后由作者于 2008-10-10 16:04:42 编辑

;功能: 加载或卸载ARX程序
;作用: 提供给开发ARX开发的朋友,方便大家在开发调试ARX时,调试ARX程序频繁执行APPLOAD命令卸载ARX程序再加载新编译的ARX程序文件
;开发语言: Auto LISP
;开发: 包达勇<BDYCAD>
;日期: 2008-10-10
;执行命令: BRX
;开发用时: 10分钟
;F:\Program\ARX\ObjectEdit\Debug\ObjectEdit.arx
(defun c:brx(/ ARXFILE DCL_F DCL_ID DD PATH)
(IF(NOT(SETQ Path (vl-registry-READ "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath")))
(SETQ Path (vl-registry-WRITE "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath" "第一次用请加入ARX路径和ARX文件名")))
(setq dcl_F(BDYCAD->Create-ArxProgramTestDCL));;;生成DCL文件
(setq dcl_id (load_dialog dcl_F)) ;载入对话框
(if (not (new_dialog "BDYCAD001" dcl_id))(exit)) ;_ 结束if
(Set_tile "ArxFile" Path)
(action_tile "Find" "(BDYCAD->FindFileArxProgram)")
(action_tile "AddArx""(setq Path(get_tile "ArxFile"))(done_dialog 1)")
(action_tile "ULArx""(setq Path(get_tile "ArxFile"))(done_dialog 2)")
(action_tile "ExitDcl""(done_dialog 0)")
(SETQ DD(start_dialog))
(unload_dialog dcl_id)
(vl-file-delete dcl_F)
(vl-registry-WRITE "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath" Path)
(cond
((= DD 0)
(Princ "\n报告:你退出对话框,没有做任可操作:)")
)
((= DD 1)
(if(findfile Path)
(progn
(if(and(VL-FileName-Base Path)(vl-filename-extension Path))
(progn
(setq ArxFile(strcase(strcat(VL-FileName-Base Path)(vl-filename-extension Path)) T))
(if(member ArxFile(arx))(arxunload ArxFile))
))
(arxload Path)
(Princ"\n报告: 我测试的ARX程序成功加载喽,请你努力测试并改进程序吧:)")
)
(Princ"\n报告: 没有找到要加载的ARX程序文件,请查一下是不是该路径不对或该程序文件不存在再试过."))
)
((= DD 2)
(IF(findfile Path)
(if(and(VL-FileName-Base Path)(vl-filename-extension Path))
(progn
(setq ArxFile(strcase(strcat(VL-FileName-Base Path)(vl-filename-extension Path))t))
(if(member ArxFile(arx))
(progn
(arxunload ArxFile)
(Princ(strcat"\n报告: 成功卸载了"ArxFile"程序"))
)
)
)
)(Princ"\n报告: 没有找到要加载的ARX程序文件,请查一下是不是该路径不对或该程序文件不存在再试过."))
))
(princ)
)
(defun BDYCAD->FindFileArxProgram()
(IF(setq Path (GETFILED "选择ARX程序文档" "" "ARX" 4))
(Set_tile "ArxFile" Path))
)
(defun BDYCAD->Create-ArxProgramTestDCL(/ FILE FINDF NEEW x)
(setq findf(findfile "acad.dcl")
neew (strcat (substr findf 1 (- (strlen findf) 8)) "BDYCAD.DCL")
file (open neew "w"))
(foreach x (list
"BDYCAD001:dialog{label="BDYCAD软件开发调试VC++,ARX";"
":boxed_radio_column{label="";"
":row{:edit_box{ label="ARX文件"; key="ArxFile";edit_width=50;}"
":button{label="设定ARX";key="Find";}}"
":row{:button{label="加载ARX";key="AddArx";is_default=true;}"
":button{label="卸载ARX";key="ULArx";is_default=true;}"
":button{label="退出";key="ExitDcl";is_default=true;}}}}"
)
(princ(strcat x"\n") file)
)
(close file)
neew)

;功    能: 加载或卸载ARX程序
;作    用: 提供给开发ARX开发的朋友,方便大家在开发调试ARX时,调试ARX程序频繁执行APPLOAD命令卸载ARX程序再加载新编译的ARX程序文件
;开发语言: Auto LISP
;开    发: 包达勇<BDYCAD>
;日    期: 2008-10-10
;执行命令: BRX
;开发用时: 10分钟
;F:\Program\ARX\ObjectEdit\Debug\ObjectEdit.arx
(defun c:brx(/ ARXFILE DCL_F DCL_ID DD PATH)
  (IF(NOT(SETQ Path (vl-registry-READ "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath")))
 (SETQ Path (vl-registry-WRITE "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath" "第一次用请加入ARX路径和ARX文件名")))
  (setq dcl_F(BDYCAD->Create-ArxProgramTestDCL));;;生成DCL文件
  (setq dcl_id (load_dialog dcl_F)) ;载入对话框
  (if (not (new_dialog "BDYCAD001" dcl_id))(exit)) ;_ 结束if
  (Set_tile "ArxFile" Path)
  (action_tile "Find" "(BDYCAD->FindFileArxProgram)")
  (action_tile "AddArx""(setq Path(get_tile "ArxFile"))(done_dialog 1)")
  (action_tile "ULArx""(setq Path(get_tile "ArxFile"))(done_dialog 2)")
  (action_tile "ExitDcl""(done_dialog 0)")
  (SETQ DD(start_dialog))
  (unload_dialog dcl_id)
  (vl-file-delete dcl_F)
  (vl-registry-WRITE "HKEY_CURRENT_USER\\Software\\Autodesk\\BDYCAD" "ArxTestPath" Path)
  (cond
    ((= DD 0)
     (Princ "\n报告:你退出对话框,没有做任可操作:)")
     )
    ((= DD 1)
     (if(findfile Path)
       (progn
  (if(and(VL-FileName-Base Path)(vl-filename-extension Path))
       (progn
       (setq ArxFile(strcase(strcat(VL-FileName-Base Path)(vl-filename-extension Path)) T))
       (if(member ArxFile(arx))(arxunload ArxFile))
       ))
  (arxload Path)
  (Princ"\n报告: 我测试的ARX程序成功加载喽,请你努力测试并改进程序吧:)")
  )
       (Princ"\n报告: 没有找到要加载的ARX程序文件,请查一下是不是该路径不对或该程序文件不存在再试过."))
     )
    ((= DD 2)
     (IF(findfile Path)
     (if(and(VL-FileName-Base Path)(vl-filename-extension Path))
       (progn
       (setq ArxFile(strcase(strcat(VL-FileName-Base Path)(vl-filename-extension Path))t))
       (if(member ArxFile(arx))
  (progn
    (arxunload ArxFile)
    (Princ(strcat"\n报告: 成功卸载了"ArxFile"程序"))
    )
  )
       )
       )(Princ"\n报告: 没有找到要加载的ARX程序文件,请查一下是不是该路径不对或该程序文件不存在再试过."))
     ))
  (princ)
  )
(defun BDYCAD->FindFileArxProgram()
  (IF(setq Path (GETFILED "选择ARX程序文档" "" "ARX" 4))
  (Set_tile "ArxFile" Path))
  )
(defun BDYCAD->Create-ArxProgramTestDCL(/ FILE FINDF NEEW x)
 (setq findf(findfile "acad.dcl")
    neew (strcat (substr findf 1 (- (strlen findf) 8)) "BDYCAD.DCL")
    file (open neew "w"))
 (foreach x (list
"BDYCAD001:dialog{label="BDYCAD软件开发调试VC++,ARX";"
":boxed_radio_column{label="";"
":row{:edit_box{ label="ARX文件"; key="ArxFile";edit_width=50;}"
":button{label="设定ARX";key="Find";}}"
":row{:button{label="加载ARX";key="AddArx";is_default=true;}"
":button{label="卸载ARX";key="ULArx";is_default=true;}"
":button{label="退出";key="ExitDcl";is_default=true;}}}}"
                 )
       (princ(strcat x"\n") file)
     )
  (close file)
  neew)

庞琛虹 · 发表于 2008-12-28 10:48

太好了

ship120 · 发表于 2009-2-19 12:58

楼主真棒啊，我要向你都多学习！

BDYCAD · 发表于 2009-3-10 08:34

三点画弧ARX源代码:

AcDbBlockTableRecord *GetModelSpace(AcDb::OpenMode Mode){
AcDbDatabase *pDwg = acdbHostApplicationServices()->workingDatabase();
AcDbBlockTable *pBlockTable;
AcDbBlockTableRecord *pModelSpace;
pDwg->getSymbolTable(pBlockTable, AcDb::kForRead);
pBlockTable->getAt(ACDB_MODEL_SPACE, pModelSpace, Mode);
pBlockTable->close();
return pModelSpace;
}
//功能:三点画弧
//编程:包达勇
//时间:20080812
AcDbObjectId CreateArc(ads_point pt1,ads_point pt2,ads_point pt3){
bool LongARC=FALSE;
AcDbCurve *pCur;
AcDbArc *pArc;
ads_point /*pt1,pt2,pt3,*/cpt,mp1,mp2,mp3,mp4;
ads_real GDist1,GDist2,Dist,Angle1,Angle2,Radius,StartAngle,EndAngle;
GDist1=GDist2=0;
AcGePoint3d Mid,Mp1,Mp2,Cpt;
AcGePoint3d Spt,Mpt,Ept;
Spt=asPnt3d(pt1);Mpt=asPnt3d(pt2);Ept=asPnt3d(pt3);
Mid=Mpt;
Dist=acutDistance(pt1,pt2);
Angle1=acutAngle(pt1,pt2);
Angle2=acutAngle(pt3,pt2);
acutPolar(pt1,Angle1,acutDistance(pt1,pt2)*0.5,mp1);
acutPolar(pt3,Angle2,acutDistance(pt3,pt2)*0.5,mp2);
acutPolar(mp1,Angle1+(pi*0.5),Dist,mp3);
acutPolar(mp2,Angle2+(pi*0.5),Dist,mp4);
acdbInters(mp1,mp3,mp2,mp4,FALSE,cpt);
Cpt=asPnt3d(cpt);
Radius=acutDistance(cpt,pt2);
StartAngle=acutAngle(cpt,pt1);
EndAngle=acutAngle(cpt,pt3);
AcDbObjectId ObjID,ObjID1,ObjID2;
AcDbBlockTableRecord *pModelSpace =GetModelSpace(AcDb::kForWrite);
AcDbArc *Narc1=new AcDbArc(Cpt,Radius,StartAngle,EndAngle);
AcDbArc *Narc2=new AcDbArc(Cpt,Radius,EndAngle,StartAngle);
pModelSpace->appendAcDbEntity(ObjID1,Narc1);
pModelSpace->appendAcDbEntity(ObjID2,Narc2);
Narc1->close();
Narc2->close();
pModelSpace->close();
acdbOpenObject(pCur,ObjID1,AcDb::kForRead);
pCur->getDistAtPoint(Mid,GDist1);
pCur->close();
acdbOpenObject(pCur,ObjID2,AcDb::kForRead);
pCur->getDistAtPoint(Mid,GDist2);
pCur->close();
if (GDist1>GDist2) {
EraseEntity(ObjID2);
ObjID=ObjID1;
}else{
EraseEntity(ObjID1);
ObjID=ObjID2;
}
return ObjID;
}

复制代码

cfu18 · 发表于 2009-3-10 21:27

我也发发,最简单的jig

class CRectJig :public AcEdJig
{
public:
CRectJig()
{
  pLine = 0;
  nColor = 1;
}
~CRectJig()
{
  if (pLine)
  {
   delete pLine;
   pLine = 0;
  }
}
void setColor(int Color){nColor = Color;}
bool doIt()
{
  if(!pLine)
   pLine = new AcDbPolyline;

  ads_point pt1;

  if(ads_getpoint(NULL,str,pt1)!=RTNORM)
  {
   return FALSE;
  }
  ptS = TransUcs2Wcs(asPnt3d(pt1),FALSE);
  ptE = AcGePoint3d(ptS.x+1,ptS.y+1,0);

  pLine->addVertexAt(0,AcGePoint2d(ptS.x,ptS.y));
  pLine->addVertexAt(1,AcGePoint2d(ptS.x,ptE.y));
  pLine->addVertexAt(2,AcGePoint2d(ptE.x,ptE.y));
  pLine->addVertexAt(3,AcGePoint2d(ptE.x,ptS.y));
  pLine->setClosed(Adesk::kTrue);
  pLine->setColorIndex(nColor);
  setDispPrompt("一些描述");
  AcEdJig::DragStatus stat = drag();
  if (stat != AcEdJig::kNormal)
   return false;
  return TRUE;
}
    DragStatus sampler()
{
  DragStatus stat;
  setUserInputControls((UserInputControls)
   (AcEdJig::kAccept3dCoordinates
    | AcEdJig::kNoNegativeResponseAccepted
    | AcEdJig::kNoZeroResponseAccepted));
  AcGePoint3d pt;
  stat = acquirePoint(pt);
  if (!pt.isEqualTo(ptE))
            ptE = pt;
        else if (stat == AcEdJig::kNormal)
            return AcEdJig::kNoChange;
  return stat;
}
    Adesk::Boolean update()
{
  pLine->setPointAt(0,AcGePoint2d(ptS.x,ptS.y));
  pLine->setPointAt(1,AcGePoint2d(ptS.x,ptE.y));
  pLine->setPointAt(2,AcGePoint2d(ptE.x,ptE.y));
  pLine->setPointAt(3,AcGePoint2d(ptE.x,ptS.y));
  return Adesk::kTrue;
}
    AcDbEntity* entity() const
{
  return pLine;
}
public:
AcDbPolyline * pLine;
AcGePoint3d ptS,ptE;
int nColor;
};

TransUcs2Wcs()是一个函数转换点的,UCS到世界坐标的

xgy3122xxz · 发表于 2010-9-29 14:08

ARX代码如何实现创建多段线，急~~~~~~

BDYCAD · 发表于 2010-10-7 13:22

AcDbBlockTableRecord *GetModelSpace(AcDb::OpenMode Mode){
AcDbDatabase *pDwg = acdbHostApplicationServices()->workingDatabase();
AcDbBlockTable *pBlockTable;
AcDbBlockTableRecord *pModelSpace;
pDwg->getSymbolTable(pBlockTable, AcDb::kForRead);
pBlockTable->getAt(ACDB_MODEL_SPACE, pModelSpace, Mode);
pBlockTable->close();
return pModelSpace;
}
//生成PLINE线。 CreatePline（点表，是否封闭）
//编程： BDYCAD　２００８０４０８
AcDbObjectId CreatePline(AcGePoint3dArray PTlist,int CloseModel/* =FALSE */){
AcDbObjectId ObjID;
AcDbBlockTableRecord *pModelSpace =GetModelSpace(AcDb::kForWrite);
Adesk::Boolean pltype;
if (CloseModel==FALSE) {
pltype=Adesk::kFalse;//曲线打开
}else if(CloseModel==TRUE){
pltype=Adesk::kTrue;//曲线封闭
}
//AcDbPolyline
AcDb2dPolyline *nPl=new AcDb2dPolyline(AcDb::k2dSimplePoly,PTlist,0.0,pltype);//AcDb::k2dCubicSplinePoly
nPl->setLayer(_T("0"));
pModelSpace->appendAcDbEntity(ObjID,nPl);
nPl->close();
pModelSpace->close();
return ObjID;
}

复制代码

shanghaisyg · 发表于 2011-4-21 14:47

雪中送炭啊！

chpmould · 发表于 2011-5-21 20:04

LISP如何调用ARX画一条线的子程序呢... ...

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

学习ARX,编个初组的命令,呵呵

本帖子中包含更多资源

评分