zhb236623 发表于 2011-6-10 15:59:08

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

本帖最后由 zhb236623 于 2011-6-10 16:01 编辑

选中闭合PLINE，不管闭合PLINE是顺时针还是逆时间方向，始终按顺时针方向画界址点。界址点的顺序可以自定义从哪点开始。利用http://bbs.mjtd.com/thread-85286-1-1.html
http://bbs.mjtd.com/thread-86881-1-1.html
;;复合线转为权属线，画界址点....
;;1.选pline,指定界址点起始点，其他按提示完成命令
(defun C:po(/ ss fd ang offsetObj plineObj)
(VL-LOAD-COM)
(if (setq ss (ssget ":s" '((0 . "*POLYLINE"))))
   (progn
    (setq plineObj (vlax-ename->vla-object (ssname ss 0)))
    ;(setq fd (vlax-curve-getFirstDeriv plineObj 0.5))
    ;(setq ang (atan (/ (cadr fd) (car fd))))
    (setq offsetplineObj (car (vlax-safearray->list
      (vlax-variant-value
      (vla-OFFSET plineObj 0.0001)))))
    (if (> (vlax-curve-getdistatparam
         plineobj
         (vlax-curve-getEndParam plineobj)
         ) ;_ 结束vlax-curve-getdistatparam
         (vlax-curve-getdistatparam
         offsetplineObj
         (vlax-curve-getEndParam offsetplineObj)
         ) ;_ 结束vlax-curve-getdistatparam
      )
       (princ "\n该多义线为顺时针。")
       (command "huan" ss)
    )
    (vla-delete offsetplineObj)
   );progn
   (princ "\n没有选择多段线.")
);end_if
(wwww)
(setq ssss(ssget "p"))
(command "PLTOJZLINE" ssss )

)

(defun wwww()
;;(princ"按指定点作为起点重绘pline.   ")
(VL-LOAD-COM)
;;(setvar "cmdecho" 0)
(setq sss(ssget "p"))
(setq ee (ssname sss 0))
;(setq ee(car(entsel"选择对象")))
(setq p1(getpoint"选择顶点"))
(plchangestart ee p1)

)

(defun plchangestart(ee p1 / pt dat ptfrst ename aa data datb dat0 dat1 dat9)
(setq pt (list (car p1) (cadr p1)))
(setq dat (entget ee))
(setq ptfrst (cons 10 pt))
(setq ename (vlax-ename->vla-object ee))
(if (vlax-curve-isclosed ename)
    (setq dat dat)
    (progn (setq dat (subst (cons 70 129) (assoc 70 dat) dat))
   (setq data (list (last dat)))
   (setq datb (reverse (cdr (cdr (cdr (cdr (cdr (reverse dat))))))))
   (setq dat (entmod (append datb data)))
    ) ;_ 结束progn
) ;_ 结束if
;;以上一段：如果pl最终不是以“c”闭合而是以捕捉端点方式“闭合”，
;;则修改组码使其达到闭合效果。
(setqdat0 (reverse (member (assoc 39 dat) (reverse dat)))
dat1 (cdr (member (assoc 39 dat) dat))
dat9 (list (last dat1))
dat1 (reverse (cdr (reverse dat1)))
data (member ptfrst dat1)
datb (reverse (cdr (member ptfrst (reverse dat1))))
) ;_ 结束setq
(entmod (append dat0 data datb dat9))

;;以上一段：修改组码，使pline从指定点开始。
) ;_ 结束defun

cuyongping 发表于 2013-2-27 11:04:26

好东西！呵呵!

479274135 发表于 2016-10-10 14:35:36

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

柴月二号 发表于 2016-10-11 20:47:50

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

lioun4105 发表于 2019-9-26 17:02:30

看看好用不

hncjddd 发表于 2019-10-18 14:54:14

异常完美，感谢解决了一个长期困扰的问题..........
页: [1]
查看完整版本: 南方CASS，生成界址点程序，感觉自带的不好用。