本帖最后由 hpy 于 2022-2-22 17:35 编辑
下面这段代码从网上找到的,修改了一下。程序优点:创建填充图案时可以不用把线画出来,只需给定点表即可。缺点:只对由直线构成的多边形有用,对直线与曲线构成的区域和曲线构成的区域没用。
- ;;功能:对单个或多个区域创建hatch填充
- ;;参数说明:lst 点表组成的点表
- ;; hatchname hatch图案名称
- ;; Layname 图层名称
- ;; hatchangle 填充角度(弧度)
- ;; pmxsca 填充比例
- ;;(entmakehatch (list (list pt1 pt2 pt3 ...) (list pt11 pt12 pt13 ...)) "hatch图案名称" "图层" 填充角度(弧度) 填充比例)
- (defun entmakehatch (Lst hatchname Layname hatchangle pmxsca)
- (entmakex
- (apply
- 'append
- (list
- (list '(0 . "HATCH")
- '(100 . "AcDbEntity")
- '(410 . "Model")
- (cons 8 Layname)
- '(100 . "AcDbHatch")
- '(10 0.0 0.0 0.0)
- '(210 0.0 0.0 1.0)
- ;; '(2 . "ANSI31")
- (cons 2 hatchname)
- (cons 62 256) ;;颜色随层
- ;;(if (= n "SOLID")
- ;; '(70 . 1)
- '(70 . 0)
- ;; ) ;_ if
- '(71 . 0)
- (cons 91 (length Lst))
- ) ;_ list
- (apply 'append
- (mapcar '(lambda (a)
- (apply 'append
- (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
- (mapcar '(lambda (b) (cons 10 b)) a)
- '((97 . 0))
- ) ;_ list
- ) ;_ apply
- ) ;_ lambda
- Lst
- ) ;_ mapcar
- ) ;_ apply
- (list '(75 . 0)
- '(76 . 1)
- (cons 52 hatchangle)
- (cons 41 pmxsca)
- '(77 . 0)
- '(78 . 1)
- (cons 53 hatchangle)
- '(43 . 0)
- '(44 . 0)
- '(45 . 1)
- ;; (cons 45 s)
- '(46 . 1)
- '(79 . 0)
- '(47 . 1)
- '(98 . 2)
- '(10 0. 0. 0.0)
- '(10 0. 0. 0.0)
- ;; '(451 . 0)
- ;; '(460 . 0.0)
- ;; '(461 . 0.0)
- ;; '(452 . 1)
- ;; '(462 . 1.0)
- ;; '(453 . 2)
- ;; '(463 . 0.0)
- ;; '(463 . 1.0)
- ;; '(470 . "LINEAR")
- ) ;_ list
- ) ;_ list
- ) ;_ apply
- ) ;_ entmakex
- ) ;_ defun
|