[ARX程序]：一个画箭头的问题,帮帮忙吧我已经是第四次发贴了

dahui180

我做了一个箭头程序没有什么问题,可是一打开对象捕捉中的中点捕捉后箭头就没了,请各位帮忙看一下:
ads_point start,end;
ads_point linestart,lineend;
acedCommand(RTSTR,"-OSNAP",RTSTR,"midpoint",0);
acedCommand(RTSTR,"-OSNAP",RTSTR,"qua",0);
acedGetPoint(NULL,"请点取起点:",linestart);
acedGetPoint(NULL,"请点取终点:",lineend);
ads_real k,d = 30;
ads_real eps = 0.000001;
ads_point_set(lineend,start);
if(fabs(lineend[X] - linestart[X]) < eps) { // 铅垂线
        end[X] = lineend[X];
if(linestart[Y] > lineend[Y])        end[Y] = lineend[Y] + d;
    else end[Y] = lineend[Y] - d;
                }
     else if(fabs(lineend[Y] - linestart[Y]) < eps) { //水平线
        end[Y] = lineend[Y];
if(linestart[X] > lineend[X])   end[X] = lineend[X] + d;
        else end[X] = lineend[X] - d;
                }
else {
       k = (lineend[Y] - linestart[Y]) / (lineend[X] - linestart[X]); //直线的斜率
        ads_real x0,y0,x1,y1;
        ads_real a,b,c;
         x0 = linestart[X]; y0 = linestart[Y];
         x1 = lineend[X];   y1 = lineend[Y];
       a = 1 + k * k;
         b = - 2 * x1 - 2 * k * k * x0 + 2 * k * (y0 - y1);
c = x1 * x1 + k * k * x0 * x0 - 2 * k * (y0 - y1) * x0 + (y0 - y1) * (y0 - y1) - d * d;

end[X] = (-b + sqrt(b * b - 4 * a * c))/ 2 / a;
if((linestart[X] - end[X]) * (lineend[X] -end[X]) > 0)
        end[X] = (-b - sqrt(b * b - 4 * a * c))/ 2 / a;
        end[Y] = k * (end[X] - x0) + y0;
                }
acedCommand(RTSTR,"LINE",RTPOINT,linestart,RTPOINT,lineend,RTSTR,"",0);

                acedCommand(RTSTR,"PLINE",0);
                acedCommand(RTPOINT,start,0);
                acedCommand(RTSTR,"W",0);
                acedCommand(RTREAL,0.0,0);
                acedCommand(RTREAL,10.0,0);
                acedCommand(RTPOINT,end,0);
                acedCommand(RTSTR,"",0);

baohui668

**************转载**********************
输入命令就可画出你想要的尺寸的箭头的方法，具体实施如下：
1)、首先拷贝下列lisp程序，用ar为名以记事本格式保存，然后改后缀名为.lsp，作为一
个lisp程序文件；程序如下：
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "
" msg "<" (rtos def) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(if (= " " (substr msg (strlen msg) 1))
(setq msg (strcat "
" (substr msg 1 (1- (strlen msg))) ": "))
(setq msg (strcat "
" msg ": "))
)
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)
(defun upoint (bit kwd msg def bpt / inp)
(if def
(setq pts (strcat
(rtos (car def))
","
(rtos (cadr def))
(if
(and (caddr def) (= 0 (getvar "FLATLAND")))
(strcat "," (rtos (caddr def)))
""
)
)
msg (strcat "
" msg "<" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
(if (= " " (substr msg (strlen msg) 1))
(setq msg (strcat "
" (substr msg 1 (1- (strlen msg))) ": "))
(setq msg (strcat "
" msg ": "))
)
)
(initget bit kwd)
(setq inp
(if bpt
(getpoint msg bpt)
(getpoint msg)
)
)
(if inp inp def)
)
(setq cm(getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun C:AR ( / #dwgsc w v pt1 pt2 pt3 )
(if(= arscl nil)(setq arscl 0.1875))
(setq #dwgsc(getvar "DIMSCALE")
W(getvar "PLINEWID")
V(getvar "OSMODE")
L(getvar "CLAYER"))
(setq arscl(ureal 7 "" "请输入箭头长度" arscl))
(setvar "OSMODE" 1)
(setq pt1 (upoint 1 "" "指定箭头顶点" nil nil))
(setvar "OSMODE" 512)
(setq PT(entsel "
选择直线上要画箭头一端的任意一点"))
(setq PT2(cadr PT))
(setq ED(entget(car PT)))
(setq PT3 (polar PT1 (angle PT1 PT2) (* #dwgsc arscl)))
(command "PLINE" pt1 "w" "0" (* #dwgsc (/ arscl 3)) pt3 "")
(setvar "OSMODE" V)
(setvar "CLAYER" L)
(setvar "plinewid" W)
(princ)
)
(setvar "cmdecho" cm)
(princ)
2)、将ar.lsp拷贝至CAD目录下的support目录下；
3)、在CAD目录下的support目录内找到文件acad2000doc.lsp文件（CAD2002下，在别的版
本CAD中可能不是这个名，这是CAD的自动加载文件）；
4)、用记事本程度打开acad2000doc.lsp文件，加入一行：(load "ar.lsp") （注意字符要
为英文字符）
5)、保存后，重新启动CAD，在命令行就可输入ar命令直接画箭头了。

arbyao

老兄，生成直线和多段线不要用命令生成啊，这个多不保险啊
生成直线可以用
AcDbLine *pLine;
pLine = new AcDbLine(pt1,pt2);

AcDbDatabase *pDb;
pDb = acdbHostApplicationServices()->workingDatabase();

Acad::ErrorStatus es ;
AcDbBlockTable *pBlockTable ;
if ( (es =pDb->getBlockTable (pBlockTable, AcDb::kForRead)) == Acad::eOk ) {
//----- Get the Model Space record and open it for write. This will be the owner of the new entity.
  AcDbBlockTableRecord *pSpaceRecord ;
  if ( (es =pBlockTable->getAt (ACDB_MODEL_SPACE, pSpaceRecord, AcDb::kForWrite)) == Acad::eOk ) {
//----- Append pEnt to Model Space, then close the Model Space record.
    es =pSpaceRecord->appendAcDbEntity (idObj, pLine);
    pSpaceRecord->close () ;
}
pBlockTable->close () ;
}

pLine->close();

同样的多段线也可以这样


起始做箭头做好是自定义一个箭头实体类

kfx2002

这个应该是正常现象！你用ads_command(...)执行画线，如果打开了捕捉功能，你输入的那几个点都被捕捉功能“捕捉”到某一点上了，画出来的时候就有问题了

dahui180

谢谢提醒~!