南方CASS，生成界址点程序，感觉自带的不好用。

zhb236623

选中闭合PLINE，不管闭合PLINE是顺时针还是逆时间方向，始终按顺时针方向画界址点。界址点的顺序可以自定义从哪点开始。利用http://bbs.mjtd.com/thread-85286-1-1.html
http://bbs.mjtd.com/thread-86881-1-1.html

2. ;;复合线转为权属线，画界址点....
   
3. ;;1.选pline,指定界址点起始点，其他按提示完成命令
   
4. (defun C:po(/ ss fd ang offsetObj plineObj)
   
5. (VL-LOAD-COM)
   
6. (if (setq ss (ssget ":s" '((0 . "*POLYLINE"))))
   
7.    (progn
   
8.     (setq plineObj (vlax-ename->vla-object (ssname ss 0)))
   
9.     ;(setq fd (vlax-curve-getFirstDeriv plineObj 0.5))
   
10.     ;(setq ang (atan (/ (cadr fd) (car fd))))
    
11.     (setq offsetplineObj (car (vlax-safearray->list
    
12.       (vlax-variant-value
    
13.         (vla-OFFSET plineObj 0.0001)))))
    
14.     (if (> (vlax-curve-getdistatparam
    
15.            plineobj
    
16.            (vlax-curve-getEndParam plineobj)
    
17.          ) ;_ 结束vlax-curve-getdistatparam
    
18.          (vlax-curve-getdistatparam
    
19.            offsetplineObj
    
20.            (vlax-curve-getEndParam offsetplineObj)
    
21.          ) ;_ 结束vlax-curve-getdistatparam
    
22.       )
    
23.        (princ "\n该多义线为顺时针。")
    
24.        (command "huan" ss)
    
25.     )
    
26.     (vla-delete offsetplineObj)
    
27.    );progn
    
28.    (princ "\n没有选择多段线.")
    
29. );end_if
    
30. (wwww)
    
31. (setq ssss(ssget "p"))
    
32. (command "PLTOJZLINE" ssss )
    
33. 
    
34. )
    
35. 
    
36. (defun wwww()
    
37. ;;(princ"按指定点作为起点重绘pline.     ")
    
38. (VL-LOAD-COM)
    
39. ;;(setvar "cmdecho" 0)
    
40. (setq sss(ssget "p"))
    
41. (setq ee (ssname sss 0))
    
42. ;(setq ee(car(entsel"选择对象")))
    
43. (setq p1(getpoint"选择顶点"))
    
44. (plchangestart ee p1)
    
45. 
    
46. )
    
47. 
    
48. (defun plchangestart(ee p1 / pt dat ptfrst ename aa data datb dat0 dat1 dat9)
    
49.   (setq pt (list (car p1) (cadr p1)))
    
50.   (setq dat (entget ee))
    
51.   (setq ptfrst (cons 10 pt))
    
52.   (setq ename (vlax-ename->vla-object ee))
    
53.   (if (vlax-curve-isclosed ename)
    
54.     (setq dat dat)
    
55.     (progn (setq dat (subst (cons 70 129) (assoc 70 dat) dat))
    
56.      (setq data (list (last dat)))
    
57.      (setq datb (reverse (cdr (cdr (cdr (cdr (cdr (reverse dat))))))))
    
58.      (setq dat (entmod (append datb data)))
    
59.     ) ;_ 结束progn
    
60.   ) ;_ 结束if
    
61.   ;;以上一段：如果pl最终不是以“c”闭合而是以捕捉端点方式“闭合”，
    
62.   ;;则修改组码使其达到闭合效果。
    
63.   (setq  dat0 (reverse (member (assoc 39 dat) (reverse dat)))
    
64.   dat1 (cdr (member (assoc 39 dat) dat))
    
65.   dat9 (list (last dat1))
    
66.   dat1 (reverse (cdr (reverse dat1)))
    
67.   data (member ptfrst dat1)
    
68.   datb (reverse (cdr (member ptfrst (reverse dat1))))
    
69.   ) ;_ 结束setq
    
70. (entmod (append dat0 data datb dat9))
    
71. 
    
72.   ;;以上一段：修改组码，使pline从指定点开始。
    
73. ) ;_ 结束defun

;;复合线转为权属线，画界址点....<br /> ;;1.选pline,指定界址点起始点，其他按提示完成命令<br /> (defun C:po(/ ss fd ang offsetObj plineObj)<br /> (VL-LOAD-COM) <br /> (if (setq ss (ssget ":s" '((0 . "*POLYLINE"))))<br />    (progn<br />     (setq plineObj (vlax-ename->vla-object (ssname ss 0)))<br />     ;(setq fd (vlax-curve-getFirstDeriv plineObj 0.5))<br />     ;(setq ang (atan (/ (cadr fd) (car fd))))<br />     (setq offsetplineObj (car (vlax-safearray->list<br />       (vlax-variant-value<br />         (vla-OFFSET plineObj 0.0001)))))<br />     (if (> (vlax-curve-getdistatparam<br />            plineobj<br />            (vlax-curve-getEndParam plineobj)<br />          ) ;_ 结束vlax-curve-getdistatparam<br />          (vlax-curve-getdistatparam<br />            offsetplineObj<br />            (vlax-curve-getEndParam offsetplineObj)<br />          ) ;_ 结束vlax-curve-getdistatparam<br />       )<br />        (princ "\n该多义线为顺时针。")<br />        (command "huan" ss)<br />     )<br />     (vla-delete offsetplineObj)<br />    );progn<br />    (princ "\n没有选择多段线.")<br /> );end_if<br /> (wwww)<br /> (setq ssss(ssget "p"))<br /> (command "PLTOJZLINE" ssss )<br /> <br /> )<br /> <br /> (defun wwww()<br /> ;;(princ"按指定点作为起点重绘pline.     ")<br /> (VL-LOAD-COM)<br /> ;;(setvar "cmdecho" 0)<br /> (setq sss(ssget "p"))<br /> (setq ee (ssname sss 0))<br /> ;(setq ee(car(entsel"选择对象")))<br /> (setq p1(getpoint"选择顶点"))<br /> (plchangestart ee p1)<br /> <br /> )<br /> <br /> (defun plchangestart(ee p1 / pt dat ptfrst ename aa data datb dat0 dat1 dat9)<br />   (setq pt (list (car p1) (cadr p1)))<br />   (setq dat (entget ee))<br />   (setq ptfrst (cons 10 pt))<br />   (setq ename (vlax-ename->vla-object ee))<br />   (if (vlax-curve-isclosed ename)<br />     (setq dat dat)<br />     (progn (setq dat (subst (cons 70 129) (assoc 70 dat) dat))<br />      (setq data (list (last dat)))<br />      (setq datb (reverse (cdr (cdr (cdr (cdr (cdr (reverse dat))))))))<br />      (setq dat (entmod (append datb data)))<br />     ) ;_ 结束progn<br />   ) ;_ 结束if<br />   ;;以上一段：如果pl最终不是以“c”闭合而是以捕捉端点方式“闭合”，<br />   ;;则修改组码使其达到闭合效果。<br />   (setq  dat0 (reverse (member (assoc 39 dat) (reverse dat)))<br />   dat1 (cdr (member (assoc 39 dat) dat))<br />   dat9 (list (last dat1))<br />   dat1 (reverse (cdr (reverse dat1)))<br />   data (member ptfrst dat1)<br />   datb (reverse (cdr (member ptfrst (reverse dat1))))<br />   ) ;_ 结束setq<br /> (entmod (append dat0 data datb dat9))<br /> <br />   ;;以上一段：修改组码，使pline从指定点开始。<br /> ) ;_ 结束defun

cuyongping

好东西！呵呵!

479274135

学习一下 ........

柴月二号

huan 未知命令“HUAN”  没用过cass  请问楼主 命令huan  是什么

lioun4105

看看好用不

hncjddd

异常完美，感谢解决了一个长期困扰的问题..........