请大神完善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）

gzxl

好多错误，先纠正错误先
(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 "你选择的高程点没有属性!")
      )
    )
  )
)

gzxl

好多错误，纠正错误先

2. (defun c:tt (/ s1 a1 txt pt1 txtbox x y pt2 pt3)
   
3.   (princ "\n请选择高程点:")
   
4.   (setq s1 (ssget ":s" '((0 . "INSERT"))))
   
5.   (if s1
   
6.     (progn
   
7.       (setq a1 (ssname s1 0))
   
8.       (setq txt (entnext a1))
   
9.       (setq txt (entget txt))
   
10.       (if (= (cdr (assoc 0 txt)) "ATTRIB")
    
11.         (progn
    
12.           (setq pt1 (cdr (assoc 10 txt)))
    
13.           (setq pt1 (list (car pt1) (cadr pt1)))
    
14.           (setq txtbox (textbox txt))
    
15.           (setq txtbox (cdr txtbox))
    
16.           (setq txtbox (car txtbox))
    
17.           (setq x (car txtbox))
    
18.           (setq y (cadr txtbox))
    
19.           (setq pt1 (polar pt1 (* 1.25 pi) 0.1414))
    
20.           (setq pt2 (polar pt1 0.0 (+ x 0.2)))
    
21.           (setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))
    
22.           (setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))
    
23.           (command "wipeout" pt1 pt2 pt3 pt4 "c")
    
24.           (command "draworder" al "" "f")
    
25.         )
    
26.         (print "你选择的高程点没有属性!")
    
27.       )
    
28.     )
    
29.   )
    
30. )

(defun c:tt (/ s1 a1 txt pt1 txtbox x y pt2 pt3)<br />   (princ "\n请选择高程点:")<br />   (setq s1 (ssget ":s" '((0 . "INSERT"))))<br />   (if s1<br />     (progn<br />       (setq a1 (ssname s1 0))<br />       (setq txt (entnext a1))<br />       (setq txt (entget txt))<br />       (if (= (cdr (assoc 0 txt)) "ATTRIB")<br />         (progn<br />           (setq pt1 (cdr (assoc 10 txt)))<br />           (setq pt1 (list (car pt1) (cadr pt1)))<br />           (setq txtbox (textbox txt))<br />           (setq txtbox (cdr txtbox))<br />           (setq txtbox (car txtbox))<br />           (setq x (car txtbox))<br />           (setq y (cadr txtbox))<br />           (setq pt1 (polar pt1 (* 1.25 pi) 0.1414))<br />           (setq pt2 (polar pt1 0.0 (+ x 0.2)))<br />           (setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))<br />           (setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))<br />           (command "wipeout" pt1 pt2 pt3 pt4 "c")<br />           (command "draworder" al "" "f")<br />         )<br />         (print "你选择的高程点没有属性!")<br />       )<br />     )<br />   )<br /> )

yfy2003

能改成ARX的吗？

gzxl

ARX好像是这样写，好像有点问题

1.         acDocManager->lockDocument(acDocManager->curDocument());        
   
2.         ads_name ss;
   
3.         struct resbuf *rb;
   
4.         rb = acutBuildList(RTDXF0, _T("INSERT"), 2, _T("GC200"), RTNONE);
   
5.         int rt = acedSSGet(NULL, NULL, NULL, rb, ss);
   
6.         if (rt != RTNORM)
   
7.         {
   
8.             acutRelRb(rb);
   
9.             acedSSFree(ss);
   
10.             return;
    
11.         }
    
12.         acutRelRb(rb);
    
13.         long len;
    
14.         acedSSLength(ss, &len);
    
15. 
    
16.         for (int i = 0; i < len; i++)
    
17.         {
    
18.             ads_name ent, ssName, nextName;
    
19.             acedSSName(ss, i, ssName);
    
20.             acdbEntNext(ssName, nextName);
    
21. 
    
22.             AcDbObjectId entId = AcDbObjectId::kNull;
    
23.             AcDbEntity *pEnt = NULL;
    
24.             acdbGetObjectId(entId, nextName);
    
25.             if (acdbOpenObject(pEnt, entId, AcDb::kForWrite) == eOk)
    
26.             {
    
27.                 if (pEnt->isKindOf(AcDbText::desc()))
    
28.                 {
    
29.                     AcDbText *pText = AcDbText::cast(pEnt);
    
30.                     AcGePoint3d posPt = pText->position();
    
31.                     double ptX, ptY, boxX, boxY;
    
32.                     ptX = posPt.x;
    
33.                     ptY = posPt.y;
    
34.                     AcDbExtents Ext;
    
35.                     pText->getGeomExtents(Ext);
    
36.                     AcGePoint3d minPt, maxPt;
    
37.                     minPt = Ext.minPoint();
    
38.                     maxPt = Ext.maxPoint();
    
39.                     boxX = maxPt.x;
    
40.                     boxY = maxPt.y;
    
41.                     ads_point pt1, pt2, pt3, pt4;
    
42.                     acutPolar(asDblArray(posPt), 1.25 * PI, 0.1414, pt1);
    
43.                     acutPolar(pt1, 0.0, boxX + 0.2, pt2);
    
44.                     acutPolar(pt2, 0.5 * PI, boxY + 0.2, pt3);
    
45.                     acutPolar(pt1, 0.5 * PI, boxY + 0.2, pt4);
    
46. 
    
47.                     acedCommand(RTSTR, TEXT("wipeout"),
    
48.                         RT3DPOINT, pt1,
    
49.                         RT3DPOINT, pt2,
    
50.                         RT3DPOINT, pt3,
    
51.                         RT3DPOINT, pt4,
    
52.                         RTSTR, _T("C"),
    
53.                         RTNONE);
    
54.                     acedCommand(RTSTR, TEXT("draworder"),
    
55.                         RTENAME, ssName,
    
56.                         RTSTR, TEXT(""),
    
57.                         RTSTR, _T("F"),
    
58.                         RTNONE);
    
59.                     pText->close();
    
60. 
    
61.                 }
    
62.                 pEnt->close();
    
63.             }
    
64.         }
    
65.         acedSSFree(ss);
    
66.         acDocManager->unlockDocument(acDocManager->curDocument());

复制代码

gzxl

// 这里不对
boxX = maxPt.x;
boxY = maxPt.y;