填充块生成边界线

填充图案生成边界线是AutoCAD的功能，和CASS没什么关系。选中填充图案，右击弹出快捷菜单，选择“生成边界”即可。

(print"分图层批量生成填充边界线-by宁 ")

(print "使用命令为：aaa")

(vl-load-com)

(defun TABLENAME (S / D R C)

 (while (setq D (tblnext S (null D)))

   (setq R (cons (cdr (assoc 2 D)) R))

 )

)

(defun TABLECOLOR (S / D R C)

 (while (setq D (tblnext S (null D)))

   (setq R (cons (cdr (assoc 62 D)) R))

 )

)

(defun C:aaa (/ LST N PT COLS)

 (setq LST (reverse (TABLENAME "LAYER")))

 (setq COLS (reverse (TABLECOLOR "LAYER")))

 (setq i 0)

 (foreach NAME LST

   (progn

     (setq col (nth i COLS))

     (setq mm (ssget "X" (list (cons 8 NAME) (cons 0 "HATCH"))))

     (if (/= mm nil)

(progn

 (entmake (list

    '(0 . "LAYER")

    '(100 . "AcDbSymbolTableRecord")

    '(100 . "AcDbLayerTableRecord")

    '(6 . "continuous") ;线型

    (CONS 62 col) ;颜色

    '(70 . 0) ;图层状态

    (CONS 2 (strcat "tpl-" NAME)) ;图层名

  )

 )

 (setvar "clayer" (strcat "tpl-" NAME))

 (setq ct (sslength mm))

 (while (> ct 0)

   (setq ct (- ct 1)

 la (ssname mm ct)

   )

   (vl-cmdf "-hatchedit" la "b" "p" "y")

 )

)

     )

     (setq i (+ i 1))

     (vl-cmdf "-layer" "off" NAME "")

   )

 )

  (setq mm (ssget "X" (list (cons 8 "tpl-*"))))

 ;(sssetfirst nil mm)

 (vl-cmdf "pedit" "m" mm "" "j" "j" "e" "0" "")

 (princ)

)

以前收集的，应该是明经通道