本帖最后由 kucha007 于 2025-3-29 15:09 编辑
来自此贴,多段线带凸度也可以填充。我做了一些优化
主要是可以生成双向的自定义填充,也支持UCS
如果需要返回图元名称就把entmake改为entmakeX
 - ;点表生成填充@ElpanovEvgeniy
- (defun T:MakeHatch4PTLst (WCSLst PatNam PatLay PatCol PatSca)
- (entmake
- (apply
- 'append
- (list
- (list
- (cons 0 "HATCH")
- (cons 100 "AcDbEntity")
- (cons 410 "Model")
- (cons 100 "AcDbHatch")
- (cons 10 '(0.0 0.0 0.0))
- (cons 210 (trans '(0 0 1) 1 0 T ))
- (if (wcmatch PatNam "_U*")
- (cons 2 "_USER")
- (cons 2 PatNam)
- )
- (cons 8 (if PatLay PatLay "0"))
- (cons 62 (if (and PatCol (< 0 (abs PatCol) 256)) PatCol 7))
- (cons 70 0);实体填充?
- (cons 71 0)
- (cons 91 (length WCSLst))
- )
- (apply
- 'append
- (mapcar
- '(lambda (XX)
- (apply
- 'append
- (list
- (list (cons 92 7) (cons 72 1) (cons 73 1) (cons 93 (/ (length XX) 2)))
- XX
- (list (cons 97 0))
- )
- )
- )
- WCSLst
- )
- )
- (list
- (cons 75 0)
- (cons 76 1)
- (cons 52 (- 0.0 (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T )))))
- (cons 41 PatSca)
- (if (and
- (wcmatch PatNam "_U*")
- (wcmatch PatNam "*-D")
- )
- (cons 77 1);双向
- (cons 77 0)
- )
- (cons 78 1)
- (cons 53 (- 0.0 (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T )))))
- (cons 43 0.)
- (cons 44 0.)
- (cons 45 1.)
- (cons 46 1.)
- (cons 79 0)
- (cons 47 1.)
- (cons 98 2)
- (cons 10 '(0.0 0.0 0.0))
- (cons 10 '(0.0 0.0 0.0))
- (cons 451 0)
- (cons 460 0.0)
- (cons 461 0.0)
- (cons 452 1)
- (cons 462 1.0)
- (cons 453 2)
- (cons 463 0.0)
- (cons 463 1.0)
- (cons 470 "LINEAR")
- )
- )
- )
- )
- )
|