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

njcknfy · 发表于 2004-10-10 16:29

本帖最后由 njcknfy 于 2020-9-10 16:07 编辑

使用南方CASS的朋友们，当你们发现有些功能不能满足你的要求时，你可以提出来，我们一起来完善，并把我们的成果与大家分享。

2020年9月10日更新：本人开通了微信公众号“林海的测绘”，欢迎大家支持

njcknfy · 发表于 2020-9-4 11:53

到今天为止，我从事测绘工作已经满30年了，老话说“三十年河东，三十年河西“，我的三十年河东生涯就算是结束了，感谢各位明经通道的朋友们这十多年对我的支持和帮助，有空我会把这这些年来CAD二次开发的文档整理出来与大家共享。今天先来个LISP调用DOS命令行窗口执行DOS命令把运行结果写入文本文件的方法，这个方法的应用场景是可以在CAD里执行DOS命令行命令，例如获取计算机CPU内核个数、网络连接状态等，我用这个是为了基于CAD调用第三方软件的脚本执行多进程运算。

(defun get_ThisComputerTXT (CMDSTR)
;;;调用DOS命令获取计算机的参数，输出到C:\TEMP\ThisComputer.txt
;;;(get_ThisComputerTXT CMDSTR)
;;;CMDSTR 参数选择: IPCONFIG PING NumberOfCores NumberOfLogicalProcessors
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "PING 192.168.20.253"))
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "NumberOfCores"))
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "Powershell Get-PhysicalDisk"))
(if (= (dos_dirp "C:\\TEMP") nil)
(dos_mkdir "C:\\TEMP\\"))
(if (findfile "C:\\TEMP\\ThisComputer.txt")
(dos_delete "C:\\TEMP\\ThisComputer.txt"))
(setq CMDSTR_LIST nil)
(setq TMPBATFILE "C:\\TEMP\\ThisComputer_TMP.bat")
(setq TMPBAT (open TMPBATFILE "w"))
(cond
((or (= CMDSTR "NumberOfCores") (= CMDSTR "NumberOfLogicalProcessors"))
(progn
(write-line "wmic cpu get NumberOfCores > c:\\temp\\Thistemp.txt" TMPBAT)
(write-line "wmic cpu get NumberOfLogicalProcessors >> c:\\temp\\Thistemp.txt"
TMPBAT)
(write-line "type c:\\temp\\Thistemp.txt > c:\\temp\\ThisComputer.txt" TMPBAT)))
(t (write-line (strcat CMDSTR " > C:\\TEMP\\ThisComputer.txt") TMPBAT)))
(close TMPBAT)
(dos_exewait "C:\\TEMP\\ThisComputer_TMP.bat")
(if (findfile "C:\\TEMP\\ThisComputer_TMP.bat")
(dos_delete "C:\\TEMP\\ThisComputer_TMP.bat"))
(if (findfile "C:\\TEMP\\Thistemp.txt")
(dos_delete "C:\\TEMP\\Thistemp.txt"))
)

(defun get_ThisComputerTXT  (CMDSTR) 
;;;调用DOS命令获取计算机的参数，输出到C:\TEMP\ThisComputer.txt 
;;;(get_ThisComputerTXT CMDSTR) 
;;;CMDSTR 参数选择:  IPCONFIG PING NumberOfCores NumberOfLogicalProcessors 
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "PING 192.168.20.253")) 
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "NumberOfCores")) 
;;;示例 (setq CMDSTR_LIST(get_ThisComputerTXT "Powershell Get-PhysicalDisk")) 
  (if (= (dos_dirp "C:\\TEMP") nil) 
    (dos_mkdir "C:\\TEMP\\")) 
  (if (findfile "C:\\TEMP\\ThisComputer.txt") 
    (dos_delete "C:\\TEMP\\ThisComputer.txt")) 
  (setq CMDSTR_LIST nil) 
  (setq TMPBATFILE "C:\\TEMP\\ThisComputer_TMP.bat") 
  (setq TMPBAT (open TMPBATFILE "w")) 
  (cond 
    ((or (= CMDSTR "NumberOfCores") (= CMDSTR "NumberOfLogicalProcessors")) 
     (progn 
       (write-line "wmic cpu get NumberOfCores > c:\\temp\\Thistemp.txt" TMPBAT) 
       (write-line "wmic cpu get NumberOfLogicalProcessors >> c:\\temp\\Thistemp.txt" 
                   TMPBAT) 
       (write-line "type c:\\temp\\Thistemp.txt > c:\\temp\\ThisComputer.txt" TMPBAT))) 
    (t (write-line (strcat CMDSTR " > C:\\TEMP\\ThisComputer.txt") TMPBAT))) 
  (close TMPBAT) 
  (dos_exewait "C:\\TEMP\\ThisComputer_TMP.bat") 
  (if (findfile "C:\\TEMP\\ThisComputer_TMP.bat") 
    (dos_delete "C:\\TEMP\\ThisComputer_TMP.bat")) 
  (if (findfile "C:\\TEMP\\Thistemp.txt") 
    (dos_delete "C:\\TEMP\\Thistemp.txt")) 
   )

njcknfy · 发表于 2023-7-10 16:55

本帖最后由 njcknfy 于 2023-7-11 09:36 编辑

随着国产CAD的发展，现在很多功能和用户体验上已经和ACAD没有啥差异了，我去年以来一直在基于中望CAD进行原有ACAD的二次开发迁移改造，目前基于WINDIWS环境的二次开发改造已经完成，后期会一直持续进行基于中望CAD的二次开发，以及还会考虑兼容国产操作系统去探究实现方法（中望CAD是支持LINUX的），希望自己在退休前能在国产操作系统和国产CAD环境顺畅的干活，基于中望CAD二次开发的一些摸索和实践，我在明经里国产CAD板块有些分享

中望CAD二次开发实践分享

http://bbs.mjtd.com/thread-187459-1-1.html

杜阳 · 发表于 2020-9-13 12:12

njcknfy 发表于 2020-9-4 11:53
到今天为止，我从事测绘工作已经满30年了，老话说“三十年河东，三十年河西“，我的三十年河东生涯就算是结 ...

楼主厉害了工作了三十年了烦了吗？？？？我工作了十五年了吧现在对测绘这个专业烦烦的可是还离不开它矛盾的心里啊

gyl · 发表于 2004-10-11 13:50

根据各种角度、距离求碎部点点位的方式太少。

njcknfy · 发表于 2004-10-11 18:45

举个例子,大家探讨一下

njcknfy · 发表于 2004-10-11 19:59

提供一个在CASS40安装版本下运行CASS51的自解压文件,在C盘释放,增加了一些自己添加的功能,文件较大,并且需要简单的配置一下 CAD,上传不了,有要的朋友上 MSN,如果我在线,可以发给你,可以将SCAS的图形格式转换到CASS图形格式.我的MSN: njcknfy@hotmail.com

njcknfy · 发表于 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 "%")
)
)
)
)
)
)

njcknfy · 发表于 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)
)

njcknfy · 发表于 2004-10-21 21:31

本帖最后由 njcknfy 于 2014-10-7 13:53 编辑

;;选择点位注记坐标
(defun c:zbzj (/ pt1 pt2 pt3 txt1 txt2 txt3 txp1 txp2 txtp3 os txtH)
(setq pt1 (getpoint "\n请选择注记点位："))
(if pt1
(progn (setq txt2 (rtos (car pt1) 2 3)
txt1 (rtos (cadr pt1) 2 3)
txt3 (rtos (caddr pt1) 2 3))
(setq txt1 (strcat "X=" (txtws txt1 3))
txt2 (strcat "Y=" (txtws txt2 3))
txt3 (strcat "H=" (txtws txt3 3)))
(setq pt2 (getpoint pt1 "\n书写位置："))
(setq txth (getvar "textsize"))
(if pt2
(progn (setq txtbox (textbox (list (cons 1 txt1)
(cons 7 (getvar "TEXTSTYLE"))
(cons 40 (getvar "textsize"))
(cons 41 1.0)
(cons 72 0)))
textdist1 (distance (nth 0 txtbox) (nth 1 txtbox)))
(setq txtbox (textbox (list (cons 1 txt2)
(cons 7 (getvar "TEXTSTYLE"))
(cons 40 (getvar "textsize"))
(cons 41 1.0)
(cons 72 0)))
textdist2 (distance (nth 0 txtbox) (nth 1 txtbox)))
(if (> textdist1 textdist2)
(setq textdist textdist1)
(setq textdist textdist2))
(if (< (car pt1) (car pt2))
(progn (setq pt3 (polar pt2 0 textdist))
(setq txtp1 (polar pt2 1.57079632679 (* txth 1.5)))
(setq txtp2 (polar pt2 1.57079632679 (* txth 0.25)))
(setq txtp3 (polar pt2 4.71238898029 (* txth 1.25))))
(progn (setq pt3 (polar pt2 3.1415926535 textdist))
(setq txtp1 (polar pt3 1.57079632679 (* txth 1.5)))
(setq txtp2 (polar pt3 1.57079632679 (* txth 0.25)))
(setq txtp3 (polar pt3 4.71238898029 (* txth 1.25)))))
(setq os (getvar "OSMODE"))
(setvar "osmode" 0)
(command "pline" pt1 pt2 pt3 "")
(command "text" txtp1 "" "0" txt1)
(command "text" txtp2 "" "0" txt2)
(command "text" txtp3 "" "0" txt3)
(setvar "osmode" os)
(strcat "注记坐标为: " txt1 "(北)　" txt2 "(东)　" txt3 "(高程)"))))
(progn (setq txth (getreal (strcat "字体大小<" (rtos (getvar "textsize") 2 4) ">")))
(if txth
(setvar "textsize" txth)))))
(defun txtws (txt i / num dotnum ls ls1str bz)
(if txt
(progn (setq txt (rtos (atof txt) 2 i))
(setq num (strlen txt)
dotnum 0
str ""
bz 0)
(repeat num
(setq dotnum (1+ dotnum)
ls (substr txt dotnum 1))
(if (= ls ".")
(setq bz (- num dotnum))))
(setq ls1 (cond ((> bz 2) txt)
((= bz 1) (strcat txt "00"))
((= bz 2) (strcat txt "0"))
((= bz 0) (strcat txt ".000"))))
ls1)
nil))

;;选择点位注记坐标 
(defun c:zbzj  (/ pt1 pt2 pt3 txt1 txt2 txt3 txp1 txp2 txtp3 os txtH) 
  (setq pt1 (getpoint "\n请选择注记点位：")) 
  (if pt1 
    (progn (setq txt2 (rtos (car pt1) 2 3) 
     txt1 (rtos (cadr pt1) 2 3) 
     txt3 (rtos (caddr pt1) 2 3)) 
     (setq txt1 (strcat "X=" (txtws txt1 3)) 
     txt2 (strcat "Y=" (txtws txt2 3)) 
     txt3 (strcat "H=" (txtws txt3 3))) 
     (setq pt2 (getpoint pt1 "\n书写位置：")) 
     (setq txth (getvar "textsize")) 
     (if pt2 
       (progn (setq txtbox    (textbox (list (cons 1 txt1) 
               (cons 7 (getvar "TEXTSTYLE")) 
               (cons 40 (getvar "textsize")) 
               (cons 41 1.0) 
               (cons 72 0))) 
        textdist1 (distance (nth 0 txtbox) (nth 1 txtbox))) 
        (setq txtbox    (textbox (list (cons 1 txt2) 
               (cons 7 (getvar "TEXTSTYLE")) 
               (cons 40 (getvar "textsize")) 
               (cons 41 1.0) 
               (cons 72 0))) 
        textdist2 (distance (nth 0 txtbox) (nth 1 txtbox))) 
        (if  (> textdist1 textdist2) 
          (setq textdist textdist1) 
          (setq textdist textdist2)) 
        (if  (< (car pt1) (car pt2)) 
          (progn (setq pt3 (polar pt2 0 textdist)) 
           (setq txtp1 (polar pt2 1.57079632679 (* txth 1.5))) 
           (setq txtp2 (polar pt2 1.57079632679 (* txth 0.25))) 
           (setq txtp3 (polar pt2 4.71238898029 (* txth 1.25)))) 
          (progn (setq pt3 (polar pt2 3.1415926535 textdist)) 
           (setq txtp1 (polar pt3 1.57079632679 (* txth 1.5))) 
           (setq txtp2 (polar pt3 1.57079632679 (* txth 0.25))) 
           (setq txtp3 (polar pt3 4.71238898029 (* txth 1.25))))) 
        (setq os (getvar "OSMODE")) 
        (setvar "osmode" 0) 
        (command "pline" pt1 pt2 pt3 "") 
        (command "text" txtp1 "" "0" txt1) 
        (command "text" txtp2 "" "0" txt2) 
        (command "text" txtp3 "" "0" txt3) 
        (setvar "osmode" os) 
        (strcat "注记坐标为: " txt1 "(北)　" txt2 "(东)　" txt3 "(高程)")))) 
    (progn (setq txth (getreal (strcat "字体大小<" (rtos (getvar "textsize") 2 4) ">"))) 
     (if txth 
       (setvar "textsize" txth))))) 
(defun txtws  (txt i / num dotnum ls ls1str bz) 
  (if txt 
    (progn (setq txt (rtos (atof txt) 2 i)) 
     (setq num  (strlen txt) 
     dotnum  0 
     str  "" 
     bz  0) 
     (repeat num 
       (setq dotnum (1+ dotnum) 
       ls    (substr txt dotnum 1)) 
       (if (= ls ".") 
         (setq bz (- num dotnum)))) 
     (setq ls1 (cond ((> bz 2) txt) 
         ((= bz 1) (strcat txt "00")) 
         ((= bz 2) (strcat txt "0")) 
         ((= bz 0) (strcat txt ".000")))) 
     ls1) 
    nil))

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

njcknfy · 发表于 2004-10-26 20:29

提供在CAD环境下，将直线(LINE)转换至轻多义线(LWPOLYLINE)；圆(CIRCLE)、弧(ARC)及包含弧段的线(POLYLINE/LWPOLYLINE)转换至将弧段转换由线段组成的轻多义线；转换不包含弧段的轻多义线(LWPOLYLINE)为二维多段线(POLYLINE)。LISP源代码，供大家参考，如有不到之处，请指教，谢谢！！

huxu56 · 发表于 2004-10-27 13:31

请问轻多义线(LWPOLYLINE)怎么画?

njcknfy · 发表于 2004-10-28 20:25

CADR14以上的版本添加了一种新的线实体，就是轻多义线，使用PLINE命令绘制的线段只要不拟合就是轻多义线，这种实体的结构简单，占用内存少，使用LIST命令查看，如果你的软件绘制的PLINE线查询的属性默认是POLYLINE，你可以修改PLINETYPE的参数，把它设置为1或2，就OK了。

账号		自动登录	找回密码
密码			注册

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

本帖子中包含更多资源

评分

相关帖子

本帖子中包含更多资源

点评

本帖子中包含更多资源

评分