请大神完善CASS的高程注记消隐程序
昨天无意间看到一篇论文，就是关于lisp插件的，有关高程注记的消隐感觉这个思路非常好，有一定的实用性。
里面有程序的主要部分，无奈本人对Lisp不在行，只会用……
大神们，可以下载了解下，看看有没有完善它的价值？小弟还是有必要的！期盼大神完善程序。
论文截图
效果截图
部分代码，根据论文，小弟手敲的哈：
(princ"请选择高程点:")
(setq s1(ssget":s"'((0. "insert"))))
(if s1
(progn
(setq a1(ssname s1 9))
(setq txt(entnext al))
(setq txt(entget txt))
(if(=(cdr(assoc 0 txt))"ATTRIB")
(prign
(setq pt1(cdr(assoc 10 txt)))
(setq pt1(list(car pt1)(cadr pt1)))
(setq txtbox(textbox txt))
(setq txtbox(cdr txtbox))
(setq txtbox(car txtbox))
(setq x(car txtbox))
(setq y(cadr txtbox))
(setq pt1(polar pt1( *1.25 pi)0.1414))
(setq pt2(polor pt2( *0.5pi)( +y0.2)))
(setq pt3(polor pt2( *0.5pi)( +y0.2)))
(command "wipeout" pt1 pt2 pt3 pt4 "c")
(command "draworder" al "" "f")
)
(print"你选择的高程点没有属性!")
)
)
)
论文下载链接：http://yunpan.cn/cfUeKRBr2tiZa （提取码：1a7b）
好多错误，先纠正错误先
(defun c:tt (/ s1 a1 txt pt1 txtbox x y pt2 pt3)
(princ "\n请选择高程点:")
(setq s1 (ssget ":s" '((0 . "INSERT"))))
(if s1
(progn
(setq a1 (ssname s1 0))
(setq txt (entnext a1))
(setq txt (entget txt))
(if (= (cdr (assoc 0 txt)) "ATTRIB")
(progn
(setq pt1 (cdr (assoc 10 txt)))
(setq pt1 (list (car pt1) (cadr pt1)))
(setq txtbox (textbox txt))
(setq txtbox (cdr txtbox))
(setq txtbox (car txtbox))
(setq x (car txtbox))
(setq y (cadr txtbox))
(setq pt1 (polar pt1 (* 1.25 pi) 0.1414))
(setq pt2 (polar pt1 0.0 (+ x 0.2)))
(setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))
(setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))
(command "wipeout" pt1 pt2 pt3 pt4 "c")
(command "draworder" al "" "f")
)
(print "你选择的高程点没有属性!")
)
)
)
) 好多错误，纠正错误先(defun c:tt (/ s1 a1 txt pt1 txtbox x y pt2 pt3)
(princ "\n请选择高程点:")
(setq s1 (ssget ":s" '((0 . "INSERT"))))
(if s1
(progn
(setq a1 (ssname s1 0))
(setq txt (entnext a1))
(setq txt (entget txt))
(if (= (cdr (assoc 0 txt)) "ATTRIB")
(progn
(setq pt1 (cdr (assoc 10 txt)))
(setq pt1 (list (car pt1) (cadr pt1)))
(setq txtbox (textbox txt))
(setq txtbox (cdr txtbox))
(setq txtbox (car txtbox))
(setq x (car txtbox))
(setq y (cadr txtbox))
(setq pt1 (polar pt1 (* 1.25 pi) 0.1414))
(setq pt2 (polar pt1 0.0 (+ x 0.2)))
(setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))
(setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))
(command "wipeout" pt1 pt2 pt3 pt4 "c")
(command "draworder" al "" "f")
)
(print "你选择的高程点没有属性!")
)
)
)
) 能改成ARX的吗？ ARX好像是这样写，好像有点问题 acDocManager->lockDocument(acDocManager->curDocument());
ads_name ss;
struct resbuf *rb;
rb = acutBuildList(RTDXF0, _T("INSERT"), 2, _T("GC200"), RTNONE);
int rt = acedSSGet(NULL, NULL, NULL, rb, ss);
if (rt != RTNORM)
{
acutRelRb(rb);
acedSSFree(ss);
return;
}
acutRelRb(rb);
long len;
acedSSLength(ss, &len);
for (int i = 0; i < len; i++)
{
ads_name ent, ssName, nextName;
acedSSName(ss, i, ssName);
acdbEntNext(ssName, nextName);
AcDbObjectId entId = AcDbObjectId::kNull;
AcDbEntity *pEnt = NULL;
acdbGetObjectId(entId, nextName);
if (acdbOpenObject(pEnt, entId, AcDb::kForWrite) == eOk)
{
if (pEnt->isKindOf(AcDbText::desc()))
{
AcDbText *pText = AcDbText::cast(pEnt);
AcGePoint3d posPt = pText->position();
double ptX, ptY, boxX, boxY;
ptX = posPt.x;
ptY = posPt.y;
AcDbExtents Ext;
pText->getGeomExtents(Ext);
AcGePoint3d minPt, maxPt;
minPt = Ext.minPoint();
maxPt = Ext.maxPoint();
boxX = maxPt.x;
boxY = maxPt.y;
ads_point pt1, pt2, pt3, pt4;
acutPolar(asDblArray(posPt), 1.25 * PI, 0.1414, pt1);
acutPolar(pt1, 0.0, boxX + 0.2, pt2);
acutPolar(pt2, 0.5 * PI, boxY + 0.2, pt3);
acutPolar(pt1, 0.5 * PI, boxY + 0.2, pt4);
acedCommand(RTSTR, TEXT("wipeout"),
RT3DPOINT, pt1,
RT3DPOINT, pt2,
RT3DPOINT, pt3,
RT3DPOINT, pt4,
RTSTR, _T("C"),
RTNONE);
acedCommand(RTSTR, TEXT("draworder"),
RTENAME, ssName,
RTSTR, TEXT(""),
RTSTR, _T("F"),
RTNONE);
pText->close();
}
pEnt->close();
}
}
acedSSFree(ss);
acDocManager->unlockDocument(acDocManager->curDocument()); // 这里不对
boxX = maxPt.x;
boxY = maxPt.y;
页:
[1]