画线自动添加标注的LISP，有点小问题，求大大门修改下。

717957265

首先感谢论坛大大们给我写的这个代码，可能最近他忙，没时间帮我修改了。
这段代码如果把CAD的标注样式改为宋体，标注文字就会压住直线。
求大大们帮忙修改下，我小白，真的不会 0.0

gaolei_gaolei

朋友 怎么上文字固定颜色，不让它随层

白色微風1991

都是大神啊，學習了

hzg912

人才，高人，学习

dingtiedt

(defun c:ll( / rlastent ss n lent ps pe ang dist midp textdist bsang)
  (setq rlastent(entlast))
  (command "._line")
  (while (/= 0 (getvar "CMDACTIVE"))
    (command pause)
  )
  (if rlastent
    (progn
    (setq ss (ssadd))
    (while (setq rlastent(entnext rlastent))
        (ssadd rlastent ss)
    ))
    (setq ss(ssget "x"))
  )
  (setq textdist(* 0.5 (getvar "textsize"));文字距离线取默认字体高度的0.5，这个高度可自己调整--
        bsang(angle  '(0 0 0) (getvar "ucsxdir"));考虑UCS--------------------------------------
        bsang(* 180.0 (/ bsang pi))
        )
  (repeat (setq n(sslength ss))
    (setq n(1- n)
          rlastent(ssname ss n)
          lent(entget rlastent)
          ps(cdr(assoc 10 lent))
          pe(cdr(assoc 11 lent))
          ang(angle ps pe)
          dist(distance ps pe)
          midp(mapcar '+ pe ps)
          midp(mapcar '* midp '(0.5 0.5 0.5))
          textinp(trans (polar midp (+ ang (* pi 0.5)) textdist) 0 1)
          ang(* 180.0 (/ ang pi))
          )
    (if (>= 270 ang 90)(setq  textinp(trans (polar midp (+ ang (* pi -0.5)) textdist) 0 1) ang(- ang 180)));保证文字向上-----------

-----
    (command ".-text" "j" "bc" "non" textinp "" (- ang bsang) (rtos dist));文字高度就是这一行的""，这个可以自己调整，或者干脆和线长

度相关--
    (princ (rtos ang))
  )
  (princ)
)

717957265

dingtiedt 发表于 2016-6-1 16:14
(defun c:ll( / rlastent ss n lent ps pe ang dist midp textdist bsang)
  (setq rlastent(entlast))
  ...

变成这样了

革天明

我使用arx写的，如有需要可给出使用平台，我打个包才能用
        // This is command 'VIEWNAMEDICT'
        static void YTMsupportSetLineLength()
        {
                Acad::ErrorStatus es;
                ads_point pt0;
                if(acedGetPoint(NULL,_T("\n请选择起点:"),pt0)==RTNORM)
                {
                        ads_point pt1;
                        while(acedGetPoint(pt0,_T("\n请选择下一点:"),pt1)==RTNORM)
                        {
                                CCreatEnt::YTMAddLine(CCreatEnt::adsPointToPoint3d(pt0),CCreatEnt::adsPointToPoint3d(pt1));
                                AcGePoint3d midpoint;
                                midpoint=CCreatEnt::GetMiddlePoint(CCreatEnt::adsPointToPoint3d(pt0),CCreatEnt::adsPointToPoint3d(pt1));
                                double linelength=CCreatEnt::adsPointToPoint3d(pt0).distanceTo(CCreatEnt::adsPointToPoint3d(pt1));
                                CString lenstr;
                                lenstr.Format(_T("%f"),linelength);
                                //AcDbObjectId MtextId=CCreatEnt::YTMAddMText(CCreatEnt::PolarPoint(midpoint,CCreatEnt::PI()*0.5,2.5),lenstr,NULL,NULL,NULL);
                                AcDbMText *pMText = new AcDbMText();

                                // 设置多行文字的特性
                                //pMText->setTextStyle(style);
                                pMText->setContents(lenstr);
                                pMText->setLocation(CCreatEnt::PolarPoint(midpoint,CCreatEnt::PI()*0.25,10));
                                pMText->setTextHeight(10);
                                pMText->setWidth(2.5);
                                pMText->setAttachment(AcDbMText::kMiddleCenter);

                                AcDbObjectId MtextId=CCreatEnt::PostToModelSpace(pMText);

                                double ang=acutAngle(pt0,pt1);                               
                                CCreatEnt::Rotate(MtextId,CCreatEnt::ToPoint2d(midpoint),ang);
                                pt0[X]=pt1[X];
                                pt0[Y]=pt1[Y];
                                pt0[Z]=pt1[Z];
                        }
                }

        }

lxdz443

二楼这个可以使用啊。

2. (defun c:ll( / rlastent ss n lent ps pe ang dist midp textdist bsang)
   
3.   (setq rlastent(entlast))
   
4.   (command "._line")
   
5.   (while (/= 0 (getvar "CMDACTIVE"))
   
6.     (command pause)
   
7.   )
   
8.   (if rlastent
   
9.     (progn
   
10.     (setq ss (ssadd))
    
11.     (while (setq rlastent(entnext rlastent))
    
12.         (ssadd rlastent ss)
    
13.     ))
    
14.     (setq ss(ssget "x"))
    
15.   )
    
16.   (setq textdist(* 0.5 (getvar "textsize"));文字距离线取默认字体高度的0.5，这个高度可自己调整--
    
17.         bsang(angle  '(0 0 0) (getvar "ucsxdir"));考虑UCS--------------------------------------
    
18.         bsang(* 180.0 (/ bsang pi))
    
19.         )
    
20.   (repeat (setq n(sslength ss))
    
21.     (setq n(1- n)
    
22.           rlastent(ssname ss n)
    
23.           lent(entget rlastent)
    
24.           ps(cdr(assoc 10 lent))
    
25.           pe(cdr(assoc 11 lent))
    
26.           ang(angle ps pe)
    
27.           dist(distance ps pe)
    
28.           midp(mapcar '+ pe ps)
    
29.           midp(mapcar '* midp '(0.5 0.5 0.5))
    
30.           textinp(trans (polar midp (+ ang (* pi 0.5)) textdist) 0 1)
    
31.           ang(* 180.0 (/ ang pi))
    
32.           )
    
33.     (if (>= 270 ang 90)(setq  textinp(trans (polar midp (+ ang (* pi -0.5)) textdist) 0 1) ang(- ang 180)));保证文字向上----------------
    
34.     (command ".-text" "j" "bc" "non" textinp "" (- ang bsang) (rtos dist));文字高度就是这一行的""，这个可以自己调整，或者干脆和线长度相关--
    
35.     (princ (rtos ang))
    
36.   )
    
37.   (princ)
    
38. )

(defun c:ll( / rlastent ss n lent ps pe ang dist midp textdist bsang)<br />   (setq rlastent(entlast))<br />   (command "._line")<br />   (while (/= 0 (getvar "CMDACTIVE"))<br />     (command pause)<br />   )<br />   (if rlastent<br />     (progn<br />     (setq ss (ssadd))<br />     (while (setq rlastent(entnext rlastent))<br />         (ssadd rlastent ss)<br />     ))<br />     (setq ss(ssget "x"))<br />   )<br />   (setq textdist(* 0.5 (getvar "textsize"));文字距离线取默认字体高度的0.5，这个高度可自己调整--<br />         bsang(angle  '(0 0 0) (getvar "ucsxdir"));考虑UCS--------------------------------------<br />         bsang(* 180.0 (/ bsang pi))<br />         )<br />   (repeat (setq n(sslength ss))<br />     (setq n(1- n)<br />           rlastent(ssname ss n)<br />           lent(entget rlastent)<br />           ps(cdr(assoc 10 lent))<br />           pe(cdr(assoc 11 lent))<br />           ang(angle ps pe)<br />           dist(distance ps pe)<br />           midp(mapcar '+ pe ps)<br />           midp(mapcar '* midp '(0.5 0.5 0.5))<br />           textinp(trans (polar midp (+ ang (* pi 0.5)) textdist) 0 1)<br />           ang(* 180.0 (/ ang pi))<br />           )<br />     (if (>= 270 ang 90)(setq  textinp(trans (polar midp (+ ang (* pi -0.5)) textdist) 0 1) ang(- ang 180)));保证文字向上----------------<br />     (command ".-text" "j" "bc" "non" textinp "" (- ang bsang) (rtos dist));文字高度就是这一行的""，这个可以自己调整，或者干脆和线长度相关--<br />     (princ (rtos ang))<br />   )<br />   (princ)<br /> )

yudigongzi1990

都是大神啊，学习了

717957265

革天明 发表于 2016-6-1 18:00
我使用arx写的，如有需要可给出使用平台，我打个包才能用
        // This is command 'VIEWNAMEDICT'
...

谢谢你 文字有倒着的 能做成正的吗？都在直线上方
cad2008

717957265

原来的作者改的，虽然我看不懂，还是发上来吧，
(defun c:ll( / rlastent ss n lent ps pe ang dist midp textdist bsang)
   (setq rlastent(entlast))
   (command "._line")
   (while (/= 0 (getvar "CMDACTIVE"))
     (command pause)
   )
   (if rlastent
     (progn
     (setq ss (ssadd))
     (while (setq rlastent(entnext rlastent))
         (ssadd rlastent ss)
     ))
     (setq ss(ssget "x"))
   )
   (setq textdist(* 0.2 (getvar "textsize"));文字距离线取默认字体高度的0.2，这个高度可自己调整--
        bsang(angle  '(0 0 0) (getvar "ucsxdir"));考虑UCS--------------------------------------
        bsang(* 180.0 (/ bsang pi))
         )
   (repeat (setq n(sslength ss))
     (setq n(1- n)
           rlastent(ssname ss n)
           lent(entget rlastent)
           ps(cdr(assoc 10 lent))
           pe(cdr(assoc 11 lent))
           ang(angle ps pe)
           dist(distance ps pe)
           midp(mapcar '+ pe ps)
           midp(mapcar '* midp '(0.5 0.5 0.5))
           )
     (cond
       ((>= (* 0.5 pi) ang 0);第一象限，
       (setq textinp(trans (polar midp (+ ang (* pi 0.5)) textdist) 0 1))
       )
       ((>= pi ang (* 0.5 pi));第二象限，
       (setq textinp(trans (polar midp (- ang (* pi 0.5)) textdist) 0 1))
        (setq ang(- ang pi))      
       )
       ((>= (* 1.5 pi) ang pi);第三象限，
       (setq textinp(trans (polar midp (- ang (* pi 0.5)) textdist) 0 1))
        (setq ang(- ang pi))
       )
       (t;第四象限，
       (setq textinp(trans (polar midp (+ ang (* pi 0.5)) textdist) 0 1))
        )
     )
     (setq ang(* 180.0 (/ ang pi)))
     (command ".-text" "j" "bc" "non" textinp "" (- ang bsang) (rtos dist));文字高度就是这一行的""，这个可以自己调整，或者干脆和线长度相关--
    (princ (rtos ang))
   )
   (princ)
)

3xxx

收藏

dingtiedt

717957265 发表于 2016-6-4 09:17
原来的作者改的，虽然我看不懂，还是发上来吧，
(defun c:ll( / rlastent ss n lent ps pe ang dist midp  ...

楼主人品还是不错，能把原作者修改的再发上来