cass下的lisp编程技术和应用：（交流贴）

mandala

开个贴，大家交流下cass9.1下的编程和应用心得。其实对lisp编程来说，cass9.1还是cass7.0几乎没有什么差别。

我先来问两个问题：

1、为什么cass9.1下，按键盘的“5”（无论大键盘还是小键盘）都会重复上一条cass命令？如果打开cass直接按“5”，那么进入的是"DD"这个程序，如果用工具画了个符号（如路灯）后，那么按“5”就重复画路灯的命令。但是cad内部命令如“pl”等不会重复。我单位所有cass都出现这个情况。

2、cass右侧菜单里“常用文字”一栏里边的文字（如“水泥”，“混”，“塘”等），默认宽高比是0.8，如何更改使它们的宽高比永远为1？

抛砖引玉，贴一个框选dwg中的线，将其变全部为cass下带编码的线型的lisp，可以将LINE,POLYLINE,LWPOLYLINE,SPLINE,ARC,circle，统一变成LWPOLYLINE ：
注意：1、该lisp需要cad下的express工具集支持，如没安装express无法工作；
      2、该命令只列出了变更陡坎的命令。如果大家觉得有用，可以参照（c:dk）里的方式自行添加变更其它线型的命令。

1. (defun c:dk ()
   
2. (setvar "CMDECHO" 0)
   
3. (ltlx "10421" "dmtz" "204201" "0")
   
4. ) ;_ 结束defun
   
5. 
   
6. 
   
7. ;给选择集中的多义线加层、线型、编码、宽度
   
8. (defun ltlx ( lt1 ly1 bm1 wide / ss ent num ss1)
   
9.   (if (cadr (ssgetfirst))
   
10.     (setq ss (ssget))
    
11.     (setq
    
12.       ss (ssget  '((0 . "LINE,POLYLINE,LWPOLYLINE,SPLINE,ARC,CIRCLE"))
    
13.    ) ;_ 结束ssget
    
14.     ) ;_ 结束setq
    
15.   ) ;_ 结束if
    
16. (setq ss (connectbypline ss))
    
17. (if (null(tblsearch "ltype" lt1))(command ".linetype" "l" lt1 "acadiso.lin" "" ))
    
18. (command "change" ss "" "p" "lt" lt1 "")
    
19.   (command "change" ss "" "p" "la" ly1 "")
    
20.     (command "._pedit" "m" ss "" "w" wide "")
    
21.   (setq num 0 )
    
22.   (repeat (sslength ss)
    
23.   (setq ent (ssname  ss num))
    
24.   (entmod (append (entget ent) (list (append (list -3) (list (append '("south") (list(cons 1000 bm1))))))))
    
25.   (setq num (1+ num))
    
26.   )
    
27.   (princ)
    
28. ) ;_ 结束defun
    
29. 
    
30. ;;子程序，将输入选择集ssp中的LINE,POLYLINE,LWPOLYLINE,SPLINE,ARC,circle，统一变成LWPOLYLINE，
    
31. ;;如果其中有首尾相连的线，则连接成一条LWPOLYLINE，
    
32. ;;最后返回一个名为xss的选择集。
    
33. 
    
34. (defun connectbypline (ssp / a xss xn ent)
    
35.   (acet-autoload2 '("FLATTENSUP.LSP" (acet-flatn ss hide)))
    
36.   ;;加载flatten函数
    
37.   (setq  a   0
    
38.   xss (ssadd)
    
39.   ) ;_ 结束setq
    
40.   (if
    
41.     (and (= (sslength ssp) 1)
    
42.    (or (= (cdr (assoc 0 (entget (ssname ssp 0)))) "LWPOLYLINE")
    
43.        (= (cdr (assoc 0 (entget (ssname ssp 0)))) "POLYLINE")
    
44.    ) ;_ 结束or
    
45.     ) ;_ 结束and
    
46.      (ssadd (ssname ssp 0) xss)
    
47.      ;;当选中的仅有一条pline的时候另作处理。
    
48.      (progn
    
49.        ;;如果有很多图元的话，全部变成pline并加入选择集xss：
    
50.        (repeat (sslength ssp)
    
51.    (setq xn (ssname ssp a))
    
52.    (setq ent (entget xn))
    
53.    (cond
    
54.      ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
    
55.       (ssadd xn xss)
    
56.      )
    
57.      ((= (cdr (assoc 0 ent)) "POLYLINE")
    
58.       (ssadd xn xss)
    
59.      )
    
60.      ((= (cdr (assoc 0 ent)) "LINE")
    
61.       (command "pedit" xn "y" "")
    
62.       (setq xn (entlast))
    
63.       (ssadd xn xss)
    
64.      )
    
65.      ((= (cdr (assoc 0 ent)) "SPLINE")
    
66.       (setq ss (ssadd))
    
67.       (ssadd xn ss)
    
68.       (acet-flatn ss nil)
    
69.             (setq xn (entlast))
    
70.       (ssadd xn xss)
    
71.      )
    
72.      ((= (cdr (assoc 0 ent)) "ARC")
    
73.       (command "pedit" xn "y" "")
    
74.       (setq xn (entlast))
    
75.       (ssadd xn xss)
    
76.      )
    
77.      ((= (cdr (assoc 0 ENT)) "CIRCLE")
    
78.       ;;圆的处理比较复杂
    
79.       (setq cp (cdr (assoc 10 ent))
    
80.       r  (cdr (assoc 40 ent))
    
81.       ) ;_ 结束setq
    
82.       (entmake
    
83.         (setq lst  (list
    
84.         '(0 . "LWPOLYLINE")
    
85.         '(100 . "AcDbEntity")
    
86.         '(67 . 0)
    
87.         '(410 . "Model")
    
88.         '(100 . "AcDbPolyline")
    
89.         '(90 . 2)
    
90.         '(70 . 129)
    
91.         (cons 10 (polar cp 0 r))
    
92.         '(40 . 0)
    
93.         '(41 . 0)
    
94.         '(42 . -1)
    
95.         (cons 10 (polar cp pi r))
    
96.         '(40 . 0)
    
97.         '(41 . 0)
    
98.         '(42 . -1)
    
99.       )    ;list
    
100.         )        ;setq
     
101.       )        ;entmake
     
102.       (command "_matchprop" xn (entlast) "")
     
103.       (entdel xn)
     
104.       (setq xn (entlast))
     
105.       (ssadd xn xss)
     
106.      )
     
107.    )        ;cond
     
108.    (setq a (+ a 1))
     
109.        )        ;repeat,以上将每个图元都变成pline并加入了选择集。
     
110.        (command "pedit" "m" xss "" "j" 0.1 "") ;;把能连的连上。
     
111.         (command "._pedit" "m" xss "" "l" "on" "");;重新生成多义线，使得线型连贯。
     
112.       (setq xss xss)
     
113.      )          ;progn
     
114.   )          ;if
     
115. ) ;_ 结束defun

(defun c:dk ()<br /> (setvar "CMDECHO" 0)<br /> (ltlx "10421" "dmtz" "204201" "0")<br /> ) ;_ 结束defun<br /> <br /> <br /> ;给选择集中的多义线加层、线型、编码、宽度<br /> (defun ltlx ( lt1 ly1 bm1 wide / ss ent num ss1)<br />   (if (cadr (ssgetfirst))<br />     (setq ss (ssget))<br />     (setq<br />       ss (ssget  '((0 . "LINE,POLYLINE,LWPOLYLINE,SPLINE,ARC,CIRCLE"))<br />    ) ;_ 结束ssget<br />     ) ;_ 结束setq<br />   ) ;_ 结束if<br /> (setq ss (connectbypline ss))<br /> (if (null(tblsearch "ltype" lt1))(command ".linetype" "l" lt1 "acadiso.lin" "" ))<br /> (command "change" ss "" "p" "lt" lt1 "")<br />   (command "change" ss "" "p" "la" ly1 "")<br />     (command "._pedit" "m" ss "" "w" wide "")<br />   (setq num 0 )<br />   (repeat (sslength ss)<br />   (setq ent (ssname  ss num))<br />   (entmod (append (entget ent) (list (append (list -3) (list (append '("south") (list(cons 1000 bm1))))))))<br />   (setq num (1+ num))<br />   )<br />   (princ)<br /> ) ;_ 结束defun<br /> <br /> ;;子程序，将输入选择集ssp中的LINE,POLYLINE,LWPOLYLINE,SPLINE,ARC,circle，统一变成LWPOLYLINE，<br /> ;;如果其中有首尾相连的线，则连接成一条LWPOLYLINE，<br /> ;;最后返回一个名为xss的选择集。<br /> <br /> (defun connectbypline (ssp / a xss xn ent)<br />   (acet-autoload2 '("FLATTENSUP.LSP" (acet-flatn ss hide)))<br />   ;;加载flatten函数<br />   (setq  a   0<br />   xss (ssadd)<br />   ) ;_ 结束setq<br />   (if<br />     (and (= (sslength ssp) 1)<br />    (or (= (cdr (assoc 0 (entget (ssname ssp 0)))) "LWPOLYLINE")<br />        (= (cdr (assoc 0 (entget (ssname ssp 0)))) "POLYLINE")<br />    ) ;_ 结束or<br />     ) ;_ 结束and<br />      (ssadd (ssname ssp 0) xss)<br />      ;;当选中的仅有一条pline的时候另作处理。<br />      (progn<br />        ;;如果有很多图元的话，全部变成pline并加入选择集xss：<br />        (repeat (sslength ssp)<br />    (setq xn (ssname ssp a))<br />    (setq ent (entget xn))<br />    (cond<br />      ((= (cdr (assoc 0 ent)) "LWPOLYLINE")<br />       (ssadd xn xss)<br />      )<br />      ((= (cdr (assoc 0 ent)) "POLYLINE")<br />       (ssadd xn xss)<br />      )<br />      ((= (cdr (assoc 0 ent)) "LINE")<br />       (command "pedit" xn "y" "")<br />       (setq xn (entlast))<br />       (ssadd xn xss)<br />      )<br />      ((= (cdr (assoc 0 ent)) "SPLINE")<br />       (setq ss (ssadd))<br />       (ssadd xn ss)<br />       (acet-flatn ss nil)<br />             (setq xn (entlast))<br />       (ssadd xn xss)<br />      )<br />      ((= (cdr (assoc 0 ent)) "ARC")<br />       (command "pedit" xn "y" "")<br />       (setq xn (entlast))<br />       (ssadd xn xss)<br />      )<br />      ((= (cdr (assoc 0 ENT)) "CIRCLE")<br />       ;;圆的处理比较复杂 <br />       (setq cp (cdr (assoc 10 ent))<br />       r  (cdr (assoc 40 ent))<br />       ) ;_ 结束setq<br />       (entmake<br />         (setq lst  (list<br />         '(0 . "LWPOLYLINE")<br />         '(100 . "AcDbEntity")<br />         '(67 . 0)<br />         '(410 . "Model")<br />         '(100 . "AcDbPolyline")<br />         '(90 . 2)<br />         '(70 . 129)<br />         (cons 10 (polar cp 0 r))<br />         '(40 . 0)<br />         '(41 . 0)<br />         '(42 . -1)<br />         (cons 10 (polar cp pi r))<br />         '(40 . 0)<br />         '(41 . 0)<br />         '(42 . -1)<br />       )    ;list<br />         )        ;setq<br />       )        ;entmake<br />       (command "_matchprop" xn (entlast) "")<br />       (entdel xn)<br />       (setq xn (entlast))<br />       (ssadd xn xss)<br />      )<br />    )        ;cond<br />    (setq a (+ a 1))<br />        )        ;repeat,以上将每个图元都变成pline并加入了选择集。<br />        (command "pedit" "m" xss "" "j" 0.1 "") ;;把能连的连上。<br />         (command "._pedit" "m" xss "" "l" "on" "");;重新生成多义线，使得线型连贯。<br />       (setq xss xss)<br />      )          ;progn <br />   )          ;if<br /> ) ;_ 结束defun

cgwang1023

楼主，有没有cass里提取横断面的程序

mandala

没有。我主要搞地籍测绘，不用横断面。

461045462

谢谢楼主的分享与交流

461045462

宽高比的修改：将cass图打开--->文件--->cass参数配置  中修改

gzxl

交流下cass9.1下的编程和应用心得
楼主是不是先放出吸引人的好贴或好代码？

mandala

461045462 发表于 2013-11-18 16:43
宽高比的修改：将cass图打开--->文件--->cass参数配置  中修改

嗯知道了，谢谢。

对于第一个问题我的表述不够清楚，是这样的：

为什么cass9.1下，按键盘的“5”（无论大键盘还是小键盘）都会重复上一条cass命令？如果打开cass直接按“5”，那么进入的是"DD"这个程序，如果用工具画了个符号（如路灯）后，那么按“5”就重复画路灯的命令。但是cad内部命令如“pl”等不会重复。我单位所有cass都出现这个情况。

看天的小树

非常感谢了。很详细啊！

杜阳

楼主，是不是关于cass9.0中一些新的功能  利用lisp来实现，这样就可以替代cass9.0的功能了，

dwjb

没看明白要表达啥，cass中命令S好像就能解决