明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 93188|回复: 278

自己动手,改进CASS中欠缺的功能

  [复制链接]
发表于 2004-10-10 16:29 | 显示全部楼层 |阅读模式
使用南方CASS的朋友们,当你们发现有些功能不能满足你的要求时,你可以提出来,我们一起来完善,并把我们的成果与大家分享。

评分

参与人数 1明经币 +1 金钱 +20 收起 理由
杜阳 + 1 + 20 很给力!

查看全部评分

发表于 2004-10-11 13:50 | 显示全部楼层
根据各种角度、距离求碎部点点位的方式太少。
 楼主| 发表于 2004-10-11 18:45 | 显示全部楼层
举个例子,大家探讨一下
 楼主| 发表于 2004-10-11 19:59 | 显示全部楼层
提供一个在CASS40安装版本下运行CASS51的自解压文件,在C盘释放,增加了一些自己添加的功能,文件较大,并且需要简单的配置一下 CAD,上传不了,有要的朋友上 MSN,如果我在线,可以发给你,可以将SCAS的图形格式转换到CASS图形格式.我的MSN:                 njcknfy@hotmail.com
 楼主| 发表于 2004-10-16 18:03 | 显示全部楼层
提供一段将LINE线转换为LWPOLYLINE的LSP原程序,大家交流交流 ;;转换LINE线至LWPOLYLINE
(defun c:linetopl ()
(setq s (ssget "X" (list (cons 0 "LINE"))))
(if (/= nil s)
(progn
(setq slen (sslength s))
(setq i 0)
(repeat slen
(setq sss (ssname s i))
(setq ss (entget (ssname s i) (list "SOUTH")))
(if (or (= nil (assoc -3 ss))
(/= (substr (cdadar (cdr (assoc -3 ss))) 1 1) "4")
)
(progn
(setq lay1 (cdr (assoc 8 ss)))
(setq pt1 (cdr (assoc 10 ss)))
(setq pt1x (car pt1))
(setq pt1y (cadr pt1))
(setq pt1 (list pt1x pt1y 0.0))
(setq ss (subst (cons 10 pt1) (assoc 10 ss) ss))
(entmod ss)
(entupd sss)
(setq pt2 (cdr (assoc 11 ss)))
(setq pt2x (car pt2))
(setq pt2y (cadr pt2))
(setq pt2 (list pt2x pt2y 0.0))
(setq ss (subst (cons 11 pt2) (assoc 11 ss) ss))
(entmod ss)
(entupd sss)
(setq qds (distance pt1 pt2))
(if (< qds 0.001)
(command "erase" sss "")
(command "pedit" sss "y" "")
)
)
)
(setq i (1+ i))
(setq rrr (rem i 6))
(setq view1 (itoa (fix (/ (* 100.0 i) slen))))
(if (= rrr 0)
(princ
(strcat "\r\t完成转换.> " view1 "%")
)
)
(if (= rrr 1)
(princ
(strcat "\r\t完成转换.>> " view1 "%")
)
)
(if (= rrr 2)
(princ
(strcat "\r\t完成转换.>>> " view1 "%")
)
)
(if (= rrr 3)
(princ
(strcat "\r\t完成转换.>>>> " view1 "%")
)
)
(if (= rrr 4)
(princ
(strcat "\r\t完成转换.>>>>> " view1 "%")
)
)
(if (= rrr 4)
(princ
(strcat "\r\t完成转换.>>>>>> " view1 "%")
)
)
)
)
)
)
 楼主| 发表于 2004-10-16 18:17 | 显示全部楼层
从图上捕捉点,在d:\temp目录下生成捕捉点的坐标CASS格式文本文件,默认文件名为yscgb.txt,以下是LSP源程序,希望对大家有用 ;;生成原始成果表
(defun c:yscgb ()
(setq file1 (getstring "\n新建数据(1)/累加数据(回车):"))
(if (= file1 "1")
(setq file (open "d:/temp/yscgb.txt" "w"))
(setq file (open "d:/temp/yscgb.txt" "a"))
)
(setq ss1 "")
(setq ss2 "")
(setq ss3 "")
(setq ss1 (getstring "\n请输入点号(1):"))
(if (= ss1 "")
(setq s1 "1")
(setq s1 ss1)
)
(setq ss1 "")
(while (/= s1 "e")
(setq s (getpoint "\n请给出图上一点:"))
(setq px (car s))
(setq px (rtos px 2 3))
(setq py (cadr s))
(setq py (rtos py 2 3))
(setq ss2 (getstring "\n请输入属性(x):"))
(if (= ss2 "")
(setq s2 "x")
(setq s2 ss2)
)
(setq ss2 "")
(setq ss3 (getstring "\n请输入高程(0):"))
(if (= ss3 "")
(setq s3 "0")
(setq s3 ss3)
)
(setq ss3 "")
(setq w (strcat s1 "," s2 "," px "," py "," s3))
(write-line w file)
(setq ss1 (getstring "\n请输入点号(+1):"))
(setq ss4 (atoi s1))
(setq ss4 (1+ ss4))
(setq ss4 (itoa ss4))
(if (= ss1 "")
(setq s1 ss4)
(setq s1 ss1)
)
(setq ss1 "")
)
(close file)
)
 楼主| 发表于 2004-10-21 21:31 | 显示全部楼层
本帖最后由 njcknfy 于 2014-10-7 13:53 编辑

  1. ;;选择点位注记坐标
  2. (defun c:zbzj  (/ pt1 pt2 pt3 txt1 txt2 txt3 txp1 txp2 txtp3 os txtH)
  3.   (setq pt1 (getpoint "\n请选择注记点位:"))
  4.   (if pt1
  5.     (progn (setq txt2 (rtos (car pt1) 2 3)
  6.      txt1 (rtos (cadr pt1) 2 3)
  7.      txt3 (rtos (caddr pt1) 2 3))
  8.      (setq txt1 (strcat "X=" (txtws txt1 3))
  9.      txt2 (strcat "Y=" (txtws txt2 3))
  10.      txt3 (strcat "H=" (txtws txt3 3)))
  11.      (setq pt2 (getpoint pt1 "\n书写位置:"))
  12.      (setq txth (getvar "textsize"))
  13.      (if pt2
  14.        (progn (setq txtbox    (textbox (list (cons 1 txt1)
  15.                (cons 7 (getvar "TEXTSTYLE"))
  16.                (cons 40 (getvar "textsize"))
  17.                (cons 41 1.0)
  18.                (cons 72 0)))
  19.         textdist1 (distance (nth 0 txtbox) (nth 1 txtbox)))
  20.         (setq txtbox    (textbox (list (cons 1 txt2)
  21.                (cons 7 (getvar "TEXTSTYLE"))
  22.                (cons 40 (getvar "textsize"))
  23.                (cons 41 1.0)
  24.                (cons 72 0)))
  25.         textdist2 (distance (nth 0 txtbox) (nth 1 txtbox)))
  26.         (if  (> textdist1 textdist2)
  27.           (setq textdist textdist1)
  28.           (setq textdist textdist2))
  29.         (if  (< (car pt1) (car pt2))
  30.           (progn (setq pt3 (polar pt2 0 textdist))
  31.            (setq txtp1 (polar pt2 1.57079632679 (* txth 1.5)))
  32.            (setq txtp2 (polar pt2 1.57079632679 (* txth 0.25)))
  33.            (setq txtp3 (polar pt2 4.71238898029 (* txth 1.25))))
  34.           (progn (setq pt3 (polar pt2 3.1415926535 textdist))
  35.            (setq txtp1 (polar pt3 1.57079632679 (* txth 1.5)))
  36.            (setq txtp2 (polar pt3 1.57079632679 (* txth 0.25)))
  37.            (setq txtp3 (polar pt3 4.71238898029 (* txth 1.25)))))
  38.         (setq os (getvar "OSMODE"))
  39.         (setvar "osmode" 0)
  40.         (command "pline" pt1 pt2 pt3 "")
  41.         (command "text" txtp1 "" "0" txt1)
  42.         (command "text" txtp2 "" "0" txt2)
  43.         (command "text" txtp3 "" "0" txt3)
  44.         (setvar "osmode" os)
  45.         (strcat "注记坐标为: " txt1 "(北) " txt2 "(东) " txt3 "(高程)"))))
  46.     (progn (setq txth (getreal (strcat "字体大小<" (rtos (getvar "textsize") 2 4) ">")))
  47.      (if txth
  48.        (setvar "textsize" txth)))))
  49. (defun txtws  (txt i / num dotnum ls ls1str bz)
  50.   (if txt
  51.     (progn (setq txt (rtos (atof txt) 2 i))
  52.      (setq num  (strlen txt)
  53.      dotnum  0
  54.      str  ""
  55.      bz  0)
  56.      (repeat num
  57.        (setq dotnum (1+ dotnum)
  58.        ls    (substr txt dotnum 1))
  59.        (if (= ls ".")
  60.          (setq bz (- num dotnum))))
  61.      (setq ls1 (cond ((> bz 2) txt)
  62.          ((= bz 1) (strcat txt "00"))
  63.          ((= bz 2) (strcat txt "0"))
  64.          ((= bz 0) (strcat txt ".000"))))
  65.      ls1)
  66.     nil))



一个坐标注记的LSP小程序,大家多提宝贵意见。应很多朋友要求,于2014年10月7日修改了坐标注记的横线长度按注记内容长度调整的一些内容

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

点评

好。 提供源码能更加理解、学习。 谢谢njcknfy  发表于 2010-12-1 15:57
 楼主| 发表于 2004-10-26 20:29 | 显示全部楼层
提供在CAD环境下,将直线(LINE)转换至轻多义线(LWPOLYLINE);圆(CIRCLE)、弧(ARC)及包含弧段的线(POLYLINE/LWPOLYLINE)转换至将弧段转换由线段组成的轻多义线;转换不包含弧段的轻多义线(LWPOLYLINE)为二维多段线(POLYLINE)。LISP源代码,供大家参考,如有不到之处,请指教,谢谢!!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1明经币 +1 收起 理由
yfy2003 + 1 【好评】表扬一下

查看全部评分

发表于 2004-10-27 13:31 | 显示全部楼层
请问轻多义线(LWPOLYLINE)怎么画?
 楼主| 发表于 2004-10-28 20:25 | 显示全部楼层
CADR14以上的版本添加了一种新的线实体,就是轻多义线,使用PLINE命令绘制的线段只要不拟合就是轻多义线,这种实体的结构简单,占用内存少,使用LIST命令查看,如果你的软件绘制的PLINE线查询的属性默认是POLYLINE,你可以修改PLINETYPE的参数,把它设置为1或2,就OK了。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-6-26 01:35 , Processed in 0.228638 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表