通信人家园

 找回密码
 注册

只需一步,快速开始

短信验证,便捷登录

搜索

军衔等级:

  上等兵

注册:2011-11-3
跳转到指定楼层
1#
发表于 2013-4-28 19:56:51 |只看该作者 |正序浏览
;;;=================================================
;;;长途杆路绘制程序。根据一定比例绘制的光缆路由图,测量出某一直线档间的距
;;;离,再根据测量出的距离自动分配好杆距,并绘出杆路。杆路转角处根据偏转角
;;;度自动增加拉线。    ---by dvm, 2002-11, v1.0
;;;=================================================
;;;生成杆路的函数
(DEFUN scgl(/ d p2 xp1 xp2 dis pm tang ta pd)
(SETQ d (/ (atof (rtos gju 2 4)) (/ r0 1000)))  ;计算实际插入点R
(SETQ p2 ( POLAR p1 a d))    ;计算第二电杆插入点
(COMMAND "insert" "ntg" p2 "" "" "")   ;插入电杆
(SETQ xp1( POLAR p1 (ANGLE p1 p2) 2.0))          ;计算吊线起点
(SETQ xp2( POLAR p2 (ANGLE p2 p1) 2.0))          ;计算吊线终点
(COMMAND "pline" xp1 xp2 "")    ;画吊线
       ;========================
(SETQ dis (DISTANCE P1 P2))    ;计算吊线中点
(SETQ pm (POLAR p1 a (/ dis 2)))   ;pm为吊线中点
(SETQ tang (REM (ATOI (ANGTOS a)) 360))   ;计算标注文字方向(角度)
(IF (< tang 0 )(SETQ tang ( + 360 tang)))  ;如果角度是负值转化为正值
(SETQ ta (ANGTOF (RTOS tang)))    ;将方向角度转换为弧度
(IF (AND (> tang 90) (< tang 270))   ;如果标注方向在90 -- 270度之间
(PROGN      ;转换到-90 -- 90度之间
  (SETQ tang (- tang 180))
  (SETQ ta (ANGTOF (RTOS tang)))
);end of progn
);endif
(SETQ pd (POLAR pm (+ 1.5707963 ta) 2.5))  ;计算文字插入点
(COMMAND "text" "J" "M" pd "3" tang (RTOS gju 2 0)) ;以中点对齐方式标注距离
(setq p1 p2)
);end defun   
;;;设定比例系数函数
(DEFUN bili()
(if (= r1 nil)
(progn
;;;当没有比例系数
(while (= r1 nil)
  (setq r0 (GETINT "\n输入比例,1:"))   
  (if (> r0 0)(setq r1 r0))
  (if (= r0 nil)(setq r1 3721))
  (if (and(<= r0 0)(/= r0 nil))
   (progn
    (prompt "比例必须是大于“0”的整数,请重新输入!")
    (setq r1 nil)
   );end progn
  );endif
);endwhile
(if (= r1 3721)(setq r1 nil))
);end progn

(progn
;;;当已经有比例系数
(setq r0 nil)
(while (= r0 nil)
  (SETQ r0 (GETREAL (STRCAT "\n输入比例 1:<"(RTOS r1 2 0) ">")))   
  (if (> r0 0)(setq r1 r0))
  (if (= r0 nil)(setq r0 r1))
  (if (and(<= r0 0)(/= r0 nil))
   (progn
    (prompt "比例必须是大于“0”的整数,请重新输入!")
    (setq r0 nil)
   );end progn
  );endif
);endwhile
);end progn
);endif
)
;;;主程序
(defun ctgl(/ ss ssb pt_b a osmo pt1 ent pt2 dist subdist a gdang subgdang gju cgdang ceco pw)
(SETVAR "cmdecho" 0)
(bili)
(if (/= nil r1)
(progn
(SETQ osmo (GETVAR "osmode"))
(setq ang nil)
(if (setq ss(ssget '((0 . "LWPOLYLINE"))))
(progn
  (setq ssb(entget(ssname ss 0)))
  (setq pt_b(assoc '10 ssb))
  (setq pt1(cdr pt_b))
  (setq ent (ssget "w" (polar pt1 0.785 4) (polar pt1 3.927 4) '((2 . "ntg"))))
  (if (= ent nil)(COMMAND "insert" "ntg" pt1 "" "" ""))
  (setq ssb(cdr(member pt_b ssb)))
  (setq pt_b(assoc '10 ssb))
  (setq pt2(cdr pt_b))
  (setq subdist 0 subgdang 0)
  (while pt2
   (SETVAR "osmode" 0)
   (setq dist(distance pt1 pt2))
   (setq a(angle pt1 pt2))
   (setq dist (rtos (* dist (/ r0 1000)) 2 0))
   (prompt (strcat "\n此直线段长度为" dist "米;"))
   (setq dist (atoi dist))
   ;;;----先计算杆档数
   (if(> dist 408)
    (progn
    (setq gdang(/ dist 50))
    (if (> (/ dist gdang) 50)(setq gdang (1+ gdang)))
    );end progn
   );end if
          (if (and(> dist 364)(<= dist 408))(setq gdang 8))
          (if (and(> dist 318)(<= dist 364))(setq gdang 7))
          (if (and(> dist 270)(<= dist 318))(setq gdang 6))
          (if (and(> dist 224)(<= dist 270))(setq gdang 5))
          (if (and(> dist 180)(<= dist 224))(setq gdang 4))
          (if (and(> dist 134)(<= dist 180))(setq gdang 3))
          (if (and(> dist 76)(<= dist 134))(setq gdang 2))
          (if (and(> dist 0)(<= dist 76))(setq gdang 1))
   ;;;----杆档数保存在gdang中
   (setq gju(/ dist gdang))(setq cgdang(rem dist gdang))
   (if (= 0 cgdang)
    (prompt (strcat "可分成" (rtos gdang 2 0) "档," "每档距离为" (rtos gju 2 0) "米。"))
    (progn
     (prompt (strcat "距离为" (rtos gju 2 0) "米的" (rtos (- gdang cgdang) 2 0) "档,"))
     (prompt (strcat "距离为" (rtos (+ 1 gju) 2 0) "米的" (rtos cgdang 2 0) "档,"))
     (prompt (strcat "共" (rtos gdang 2 0) "档。"))
    );end progn
   );endif
   (setq subdist (+ dist subdist) subgdang (+ gdang subgdang))
   (prompt (strcat "\n--累计总长度为" (rtos subdist 2 0) "米;" "共" (rtos subgdang 2 0) "档。"))
   (SETQ ceco (GETVAR "cecolor"))
   (SETQ pw (GETVAR "plinewid"))
   (setvar "plinewid" 0.6)
   (command "cecolor" "150")
   (command "-style" "" "" 0.0 0.7 "" "" "")
   (setq p1 pt1)
   (repeat (- gdang cgdang)(scgl))
   (setq gju(1+ gju))
   (repeat cgdang (scgl))
   (setvar "plinewid" pw)
   (setvar "cecolor" ceco)
   
   ;;;插入拉线
   (if ang
    (progn
    (setq an (angle pt2 pt1))
    (if (/= (abs (- ang an)) pi)
     (progn
      (if (> (abs (- ang an)) pi)
         (setq ann(+ pi (+ an(/ (- ang an) 2))))
         (setq ann(+ an(/ (- ang an) 2)))
        );end if
      (if (< (abs (- pi (abs(- an ang))))(* 0.25 pi))
       (command "-insert" "nlx" pt1 "" "" (angtos ann 0 4))
       (progn
        (command "-insert" "nlx" pt1 "" "" (angtos ang 0 4))
        (command "-insert" "nlx" pt1 "" "" (angtos an 0 4))
       );end progn
      );end if
     );end progn
     (prompt "\n转角为零,不需要增加拉线!")
    )
    );end progn
   );end if ang
   ;;;结束插入拉线
   
   (setq ang (angle pt1 pt2))
   (setq pt1 pt2)
   
   (setq ssb(cdr(member pt_b ssb)))
   (setq pt_b(assoc '10 ssb))
   (setq pt2(cdr pt_b))
  );end while pt2
);end progn
(prompt "没有选取光缆路由,请重新选取!")
);end if
(SETVAR "osmode" osmo )
);end progn
(prompt "没有比例系数,程序无法执行!")
);end if
(princ)
);end program

(defun c:ctgl(/ yn)
(if (/= xlpw "nitmd")
(progn (initget 128)
(setq yn (getkword "\n:"))
(if (= yn "pw")(progn(initget 128)(setq xlpw(getkword "\n:"))))
)
)
(if (= xlpw "nitmd")
(ctgl)
(prompt "\n不能进入程序,请与程序作者联系!")
)
)
-----------------------
试过ctgl,无效!http://www.txrjy.com/thread-535794-2-1.html这个帖子发的!

举报本楼

本帖有 1 个回帖,您需要登录后才能浏览 登录 | 注册
您需要登录后才可以回帖 登录 | 注册 |

版规|手机版|C114 ( 沪ICP备12002291号-1 )|联系我们 |网站地图  

GMT+8, 2025-7-22 23:07 , Processed in 0.264784 second(s), 17 queries , Gzip On.

Copyright © 1999-2025 C114 All Rights Reserved

Discuz Licensed

回顶部