如何用entmake 创建 hatch 实体？

Lisphk · 发表于 2013-5-30 08:57:04

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

刚看到一个朋友讨论HATCH，以前的程序对于HATCH我都是用命令去做，有没有ENTMAKE生成的方法？我试了几次，都没成。

Love-Lisp · 发表于 2013-5-30 12:18:34

Lisphk 发表于 2013-5-30 12:00
哇，这么长，都是必要的吗？能给讲讲每个组码的值的含义吗？谢谢！！！

边界路径数据
每个图案填充对象的边界由包含一条或多条线段的路径（或环）定义。路径线段数据取决于构成路径的图元类型。每条路径线段由它自己的组码集定义。关于此表中使用的缩写和格式方面的信息，请参见“本参考的格式惯例”。图案填充边界路径数据组码

组码  说明

92  边界路径类型标志（按位编码）：
0 = 默认；1 = 外部；2 = 多段线
4 = 导出；8 = 文本框；16 = 最外层

不确定
多段线边界类型数据（仅当边界 = 多段线时）。参见下面的多段线边界数据表

93  该边界路径中的边数（仅当边界不是多段线时）

72  边类型（仅当边界不是多段线时）：
1 = 直线；2 = 圆弧；3 = 椭圆弧；4 = 样条曲线

不确定
边类型数据（仅当边界不是多段线时）。参见下面的相应边数据表

97  源边界对象数

330  源边界对象的参照（多个条目）

多段线边界数据组码

组码
说明

72  “有凸度”标志

73  “关闭”标志

93  多段线顶点数

10  顶点位置（在 OCS 中）
DXF：X 值；APP：二维点（多个条目）

20
DXF：顶点位置的 Y 值（在 OCS 中）（多个条目）

42
凸度（可选；默认值 = 0）

直线边数据组码

组码
说明

10
起点（在 OCS 中）
DXF：X 值；APP：二维点

20
DXF：起点的 Y 值（在 OCS 中）

11
端点（在 OCS 中）
DXF：X 值；APP：二维点

21
DXF：端点的 Y 值（在 OCS 中）

弧边数据组码

组码
说明

10
中心点（在 OCS 中）
DXF：X 值；APP：二维点

20
DXF：中心点的 Y 值（在 OCS 中）

40
半径

50
起点角度

51
端点角度

73
“逆时针”标志

椭圆边数据组码

组码
说明

10
中心点（在 OCS 中）
DXF：X 值；APP：二维点

20
DXF：中心点的 Y 值（在 OCS 中）

11
相对于中心点的长轴端点（在 OCS 中）
DXF：X 值；APP：二维点

21
DXF：长轴端点的 Y 值（在 OCS 中）

40
短轴的长度（占长轴长度的比例）

50
起点角度

51
端点角度

73
“逆时针”标志

样条曲线边数据组码

组码
说明

94
阶数

73
有理

74
周期

95
节点数

96
控制点数

40
节点值（多个条目）

10
控制点（在 OCS 中）
DXF：X 值；APP：二维点

20
DXF：控制点的 Y 值（在 OCS 中）

42
权值（可选；默认值 = 1）

图案数据

各图案定义行重复使用以下图案数据代码。关于此表中使用的缩写和格式方面的信息，请参见“本参考的格式惯例”。填充图案数据组码

组码  说明

53
图案直线角度

43
图案直线基点，X 分量

44
图案直线基点，Y 分量

45
图案直线偏移，X 分量

46
图案直线偏移，Y 分量

79
虚线长度项目数

49
虚线长度（多个条目）

QiaoCheng · 发表于 2013-5-30 09:56:39

(entmakex
'((0 . "HATCH")
(100 . "AcDbEntity")
(62 . 1)
(100 . "AcDbHatch")
(10 0.0 0.0 0.0)
(210 0.0 0.0 1.0)
(2 . "ANSI31")
(70 . 1)
(71 . 0)
(91 . 1)
(92 . 7)
(72 . 1)
(73 . 1)
(93 . 2)
(10 32.98375559395936 269.1906470755084 0.0)
(42 . 0.414173250333224)
(10 34.15067627742974 270.3574451628437 0.0)
(42 . 2.414053538695394)
(97 . 0)
(75 . 1)
(76 . 1)
(47 . 0.021113020398065)
(98 . 1)
(10 32.80274827151152 270.0366050964267 0.0)
(450 . 0)
(451 . 0)
(460 . 0.0)
(461 . 0.0)
(452 . 0)
(462 . 0.0)
(453 . 0)
(470 . "")
)
)

复制代码

试试这样

Lisphk · 发表于 2013-5-30 12:00:11

哇，这么长，都是必要的吗？能给讲讲每个组码的值的含义吗？谢谢！！！

Free-Lancer · 发表于 2013-5-30 12:39:48

学习vla方法吧，比这个好理解来自: Android客户端

wowan1314 · 发表于 2013-5-30 13:15:25

Free-Lancer 发表于 2013-5-30 12:39
学习vla方法吧，比这个好理解

速度呢！听说entmake的速度很不错

Free-Lancer · 发表于 2013-5-30 13:22:22

除了速度，还要方便来自: Android客户端

Lisphk · 发表于 2013-5-30 13:32:16

Love-Lisp 发表于 2013-5-30 12:18
边界路径数据
每个图案填充对象的边界由包含一条或多条线段的路径（或环）定义。路径线段数据取决于构成 ...

谢谢，哪些是必须的？

wowan1314 · 发表于 2013-5-30 13:33:25

Free-Lancer 发表于 2013-5-30 13:22
除了速度，还要方便

把它做成函数呢！这样算方便了！

marting · 发表于 2013-5-30 13:47:09

本帖最后由 marting 于 2013-5-30 13:49 编辑

下面是关于HATCH的各种代码

1、DH-2line places hatch between two parallel lines
2、 DH3 uses points picked for three Corners, long side then width
3、 Hatch - Unlimited points
4、Hatch - Creates separate hatch with several objects
5、Hatch- Quick pick hatch command
6、Hatch - Matches the properties of existing hatches (sets only)
7、Hatch - Matches existing hatch and allows user to pick new object
8、Hatch - 2-point hatch
9、Hatch - 2-point circular
10、 Hatch - Pick internal point

[sell=5]

;;;Misc hatch routines
;;;============================================================================
;;; Hatch Between two parallel lines
;;;============================================================================
;;;============================================================================
;;; DH-2line places hatch between two parallel lines
;;; Creates ANSI37 hatch 90 deg
(defun C:DH-2line (/ usercmd ss er e1 e2 p1 p2 p3 p4 xp1 xp2 xp3 xp4 yp1
yp2 yp3 yp4 ang HS RB)
(setq usercmd (getvar "CMDECHO")
ss nil
er nil
HS "" ; Hatch Scale
RB "N" ; Retain Border
)
(setvar "CMDECHO" 0)
(while (not ss)
(prompt "\nSelect two parallel lines to hatch")
(setq ss (ssget)) ; ":S" may be used
(Cond
((equal ss nil)
(setq er "Nothing selected:")
)
((< (sslength SS) 2)
(setq er "too few lines selected.")
)
((> (sslength SS) 2)
(setq er "too many lines selected.")
)
(T
(setq e1 (entget (ssname ss 0)))
(setq e2 (entget (ssname ss 1)))
(if (and (= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e2)) "LINE")
)
(progn ; Both are LINES
(setq p1 (cdr (assoc 10 e1)) ; Get end points of lines
p2 (cdr (assoc 11 e1))
p3 (cdr (assoc 10 e2))
p4 (cdr (assoc 11 e2))
)
(setq xp1 (car p1) ; get x & y values of end points
xp2 (car p2)
xp3 (car p3)
xp4 (car p4)
yp1 (cadr p1)
yp2 (cadr p2)
yp3 (cadr p3)
yp4 (cadr p4)
)
; Correct for cases where two points are not exactly equal (+/- .1)
(Setq xp1 (if (equal xp1 xp2 0.1) xp2 xp1)) ; make exactly equal
(Setq xp3 (if (equal xp3 xp4 0.1) xp4 xp3)) ; make exactly equal
(Setq yp1 (if (equal yp1 yp2 0.1) yp2 yp1)) ; make exactly equal
(Setq yp3 (if (equal yp3 yp4 0.1) yp4 yp3)) ; make exactly equal
(if (or (> xp1 xp2) (and (= xp1 xp2) (> yp1 yp2))) ; Swap ends
(setq px p1 ; make starting ends the same
p1 p2 ; by swaping ends
p2 px
)
)
(if (or (> xp3 xp4) (and (= xp3 xp4) (> yp3 yp4)))
(setq px p3 ; make starting ends the same
p3 p4 ; by swaping ends
p4 px
)
)
;;;============================================================================
(setq ang (* 0.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))) ; Hatch @ 0 deg to line
(setq pi2 (* pi 2)
a1 (angle p1 p2) ; check for >= 2pi angle, set to 0 or correct to < 2pi
a1 (if (equal a1 pi2 0.0001) 0 (if (> a1 pi2) (- a1 pi2)a1))
a2 (angle p3 p4)
a2 (if (equal a2 pi2 0.0001) 0 (if (> a2 pi2) (- a2 pi2)a2))
)
(if (not (equal a1 a2 0.1)) ; (margin +/- 0.1 inch)
(setq er "lines are not parallel.")
; Lines OK to Hatch
(command "_.hatch" "" HS ang "" RB p1 p2 p4 p3 "close" "" )
) ; endif
;;;============================================================================
) ;end progn
(setq er "one or both item(s) not a LINE.")
) ; endif
) ; end (T)
) ; end cond
) ; end while
(if (/= er nil)
(alert (strcat "ERROR: " er))
)
(setvar "CMDECHO" usercmd)
(princ)
) ; end defun
(Princ)
;;;============================================================================
;;;============================================================================
;;; Hatch- three point
;;;============================================================================
;;;============================================================================
;;; DH3 uses points picked for three Corners, long side then width
;;; Creates ANSI37 hatch 90 deg
(defun C:dh3 (/ p1 p2 p3 p4 hs rb ang usercmd )
;Make 2D point from 3D point
(defun 3dP->2dP (3dpt) (list (car 3dpt) (cadr 3dpt)))
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nPick boundry points to hatch")
(setq p1 (getPoint "\nPick first point:")
p2 (getPoint p1 "\nPick along Pipe first:")
p3 (getPoint p2 "\nPick across Pipe:")
p1 (3dP->2dP p1)
p2 (3dP->2dP p2)
p3 (3dP->2dP p3)
p4 (polar p1 (angle p2 p3) (distance p2 p3))
HS 30 ; Hatch Scale
RB "N" ; Retain Border
ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))
)
(command "_.hatch" "" "" ang "" RB p1 p2 p3 p4 "close" "" )
(setvar "CMDECHO" usercmd)
(princ)
)
(Princ)
;;;===========================================================
;;; Hatch - Unlimited points
;;;===========================================================
(defun c:DH (/ hs ang usercmd)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nDraw a polyline boundry to hatch, Enter when done.")
(setq hs "" ; Hatch Scale
ang 0 ; Hatch angle
)
(command "_.hatch" "" HS ang "" "n")
(setvar "CMDECHO" usercmd)
(princ)
); end defun
(princ)
;
;
;
;;;==============================================================================
;;; Hatch - Creates separate hatch with several objects
;;;===============================================================================
(defun c:mhatch (/ sset idx hnd cmdecho)
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq sset
(ssget
'((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "OR>"))
)
)
(if sset
(progn
(command "UNDO" "_begin")
(setq idx (sslength sset))
(while (>= (setq idx (1- idx)) 0)
(setq hnd (ssname sset idx))
(command "_.hatch" "" "" "" hnd "")
)
(command "UNDO" "_end")
)
)
(setvar "CMDECHO" cmdecho)
(princ)
)
;;;==============================================================================
;;; Hatch- Quick pick hatch command
;;;===============================================================================
(defun c:h (/ ss)
(setvar "cmdecho" 0)
(prompt "\n*** Select objects for Hatch & press [Enter] ")
(if (and
(setq ss (ssget))
(> (sslength ss) 0)
)
(command "hatch" "" "" "" ss "")
)
(princ)
)
;;;==============================================================================
;;; Hatch - Matches the properties of existing hatches (sets only)
;;;===============================================================================
;; Match properties of hatch pattern selected
;; Set system variables to match
(defun c:hs (/ ent elist lay colr)
(if (setq ent (entsel))
(progn
(setq elist (entget (car ent)))
(if (= (cdr (assoc 0 elist)) "HATCH")
(progn
(command "_undo" "_begin")
(setq lay (cdr (assoc 8 elist)))
(setq colr (cdr (assoc 62 elist)))
(setvar "hpname" (cdr (assoc 2 elist)))
(setvar "hpang" (cdr (assoc 52 elist)))
(if (or (= (substr (getvar "hpname") 1 2) "_U")
(= (substr (getvar "hpname") 1 1) "U")
)
(progn
(if (= (cdr (assoc 78 elist)) 2)
(setvar "hpdouble" 1)
)
(if (= (cdr (assoc 78 elist)) 1)
(setvar "hpdouble" 0)
)
(setvar "hpspace" (cdr (assoc 41 elist)))
)
(setvar "hpscale" (cdr (assoc 41 elist)))
)
(command "_layer" "s" lay "")
(if (null colr)
(setvar "cecolor" "256")
(setvar "cecolor" (itoa (cdr (assoc 62 elist))))
)
(command "_undo" "_end")
(if c:r
(c:r)
(redraw)
)
)
(prompt "\nSelection is not a hatch")
)
)
(prompt "\nNothing selected")
)
(princ)
)
;;;===================================================================================
;;;Hatch - Matches existing hatch and allows user to pick new object
;;;===================================================================================
(defun c:mh (/ ocol olay col ent lay hat sca rot po)
(setq ocol (getvar "cecolor"))
(setq olay (getvar "clayer"))
(setq oosn (getvar "osmode"))
(setvar "osmode" 0)
(if (setq ent (entsel "\nSelect a hatch pattern to copy."))
(progn
(setq ent (entget (car ent)))
(if (= (cdr (assoc 0 ent)) "HATCH")
(progn
(setq lay (cdr (assoc 8 ent)))
(setq hat (cdr (assoc 2 ent)))
(setq sca (cdr (assoc 41 ent)))
(setq rot (cdr (assoc 52 ent)))
(setq rot (* rot (/ 180 pi)))
(setq col (cdr (assoc 62 ent))) ; may return nil
(cond
((or (= col "BYLAYER") (= col "BYBLOCK"))
(setvar "cecolor" col)
)
((= (type col) 'int)
(setvar "cecolor" (itoa col))
)
)
(command "layer" "s" lay "")
(initget "s") ; this allows numbers to be entered
(setq po
(getpoint "\nSelect Internal Point or (S)elect Objects:")
)
(if (= (type po) 'list)
(command "-bhatch" po "p" hat sca rot "")
(if (setq po (ssget)) ; allow one choice only
(command "-bhatch" "s" po "" "p" hat sca rot "")
(prompt "\nNothing selected.")
)
)
)
(prompt "\nSelection was not a hatch.")
)
)
(prompt "\nNothing selected.")
)
(setvar "clayer" olay)
(setvar "cecolor" ocol)
(setvar "osmode" oosn)
(princ)
)
;;;===================================================================================
;;; Hatch - 2-point hatch
;;;===================================================================================
(DEFUN C:2PHATCH ()
(SETVAR "CMDECHO" 0)
(SETQ
X1 (GETPOINT "\nPick 1st corner:")
Y2 (GETCORNER X1
"\nPick opposite corner: ")
LEN1 (DISTANCE X1 Y2)
ANG1 (ANGLE X1 Y2)
X2 (POLAR X1 0.0
(* LEN1 (COS ANG1)))
Y1 (POLAR Y2 PI
(* LEN1 (COS ANG1)))
)
(command "_.hatch" "" "" "" "" "n" X1 X2 Y2 Y1 "close" "")
(SETVAR "CMDECHO" 1)
(PRINC)
)
;;;===================================================================================
;;; Hatch - 2-point circular
;;;===================================================================================
(defun c:cdh ( )
(command "osmode" "16")
(command "circle" "2p" pause pause)
(command)(command)
(command "Hatch" "" pause 0 "L" "" "erase" "P" "")
(command "osmode" "0")
)
;;;===================================================================================
;;; Hatch - Pick internal point
;;;===================================================================================
(defun c:hI (/ sSet *error*)
(defun *error* (msg)
(setvar "cmdecho" 1)
); end *error*
(setvar "cmdecho" 0)
(setq ent1 (getpoint "*** Select POINT for Hatch "))
(command "_.-bhatch" ent1 "" "")
(while (= 1 (getvar "cmdactive"))
(command pause)
); end while
(command "")
(princ)
)

;;;Misc hatch routines 
;;;============================================================================ 
;;;    Hatch Between two parallel lines 
;;;============================================================================ 
;;;============================================================================ 
;;;  DH-2line places hatch between two parallel lines 
;;;  Creates ANSI37 hatch 90 deg 
(defun C:DH-2line (/ usercmd ss er e1 e2 p1 p2 p3 p4 xp1 xp2 xp3 xp4 yp1 
      yp2 yp3   yp4 ang   HS RB) 
  (setq   usercmd   (getvar "CMDECHO") 
   ss   nil 
   er   nil 
   HS   "" ; Hatch Scale 
   RB   "N" ; Retain Border 
  ) 
  (setvar "CMDECHO" 0) 
  (while (not ss) 
    (prompt "\nSelect two parallel lines to hatch") 
    (setq ss (ssget)) ;  ":S"  may be used 
    (Cond 
      ((equal ss nil) 
       (setq er "Nothing selected:") 
      ) 
      ((< (sslength SS) 2) 
       (setq er "too few lines selected.") 
      ) 
      ((> (sslength SS) 2) 
       (setq er "too many lines selected.") 
      ) 
      (T 
       (setq e1 (entget (ssname ss 0))) 
       (setq e2 (entget (ssname ss 1))) 
       (if (and   (= (cdr (assoc 0 e1)) "LINE") 
      (= (cdr (assoc 0 e2)) "LINE") 
      ) 
    (progn ; Both are LINES 
      (setq p1 (cdr (assoc 10 e1)) ; Get end points of lines 
       p2 (cdr (assoc 11 e1)) 
       p3 (cdr (assoc 10 e2)) 
       p4 (cdr (assoc 11 e2)) 
      ) 
      (setq xp1 (car p1) ; get x & y values of end points 
       xp2 (car p2) 
       xp3 (car p3) 
       xp4 (car p4) 
       yp1 (cadr p1) 
       yp2 (cadr p2) 
       yp3 (cadr p3) 
       yp4 (cadr p4) 
      ) 
      ; Correct for cases where two points are not exactly equal (+/- .1) 
      (Setq xp1 (if (equal xp1 xp2 0.1) xp2 xp1)) ; make exactly equal 
      (Setq xp3 (if (equal xp3 xp4 0.1) xp4 xp3)) ; make exactly equal 
      (Setq yp1 (if (equal yp1 yp2 0.1) yp2 yp1)) ; make exactly equal 
      (Setq yp3 (if (equal yp3 yp4 0.1) yp4 yp3)) ; make exactly equal 
 
      (if (or (> xp1 xp2) (and (= xp1 xp2) (> yp1 yp2))) ;  Swap ends 
        (setq px p1 ; make starting ends the same 
         p1 p2 ; by swaping ends 
         p2 px 
        ) 
      ) 
      (if (or (> xp3 xp4) (and (= xp3 xp4) (> yp3 yp4))) 
        (setq px p3 ; make starting ends the same 
         p3 p4 ; by swaping ends 
         p4 px 
        ) 
      ) 
;;;============================================================================ 
      (setq ang (* 0.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))) ; Hatch @ 0 deg to line 
      (setq pi2 (* pi 2) 
       a1  (angle p1 p2) ; check for >= 2pi angle, set to 0 or correct to < 2pi 
       a1  (if (equal a1 pi2 0.0001) 0 (if (> a1 pi2) (- a1 pi2)a1)) 
       a2  (angle p3 p4) 
       a2  (if (equal a2 pi2 0.0001) 0 (if (> a2 pi2) (- a2 pi2)a2)) 
      ) 
      (if (not (equal a1 a2 0.1)) ; (margin +/- 0.1 inch) 
        (setq er "lines are not parallel.") 
      ; Lines OK to Hatch          
        (command "_.hatch" "" HS ang "" RB p1 p2 p4 p3 "close" "" )            
      ) ; endif 
;;;============================================================================ 
    ) ;end progn 
    (setq er "one or both item(s) not a LINE.") 
       ) ; endif 
      ) ; end (T) 
    ) ; end cond 
  ) ; end  while 
  (if (/= er nil) 
    (alert (strcat "ERROR: " er)) 
  ) 
  (setvar "CMDECHO" usercmd) 
  (princ) 
) ; end defun 
(Princ) 
 
;;;============================================================================ 
;;;============================================================================ 
;;;    Hatch- three point 
;;;============================================================================ 
;;;============================================================================ 
;;;  DH3 uses points picked for three Corners, long side then width 
;;;  Creates ANSI37 hatch 90 deg 
 
(defun C:dh3   (/ p1 p2 p3 p4 hs rb ang usercmd )    
  ;Make 2D point from 3D point 
  (defun 3dP->2dP (3dpt) (list (car 3dpt) (cadr 3dpt))) 
 
  (setq usercmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nPick boundry points to hatch") 
  (setq   p1  (getPoint "\nPick first point:") 
   p2  (getPoint p1 "\nPick along Pipe first:") 
   p3  (getPoint p2 "\nPick across Pipe:") 
   p1  (3dP->2dP p1) 
   p2  (3dP->2dP p2) 
   p3  (3dP->2dP p3) 
   p4  (polar p1 (angle p2 p3) (distance p2 p3)) 
   HS   30      ; Hatch Scale 
   RB   "N"     ; Retain Border 
 
   ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi)) 
  ) 
(command "_.hatch" "" "" ang "" RB p1 p2 p3 p4 "close" "" ) 
  (setvar "CMDECHO" usercmd) 
  (princ) 
) 
(Princ) 
 
 
 
;;;=========================================================== 
;;;    Hatch - Unlimited points                                  
;;;=========================================================== 
(defun c:DH   (/ hs ang usercmd) 
  (setq usercmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nDraw a polyline boundry to hatch, Enter when done.") 
  (setq   hs "" ; Hatch Scale 
   ang 0 ; Hatch angle 
   ) 
   (command "_.hatch" "" HS ang "" "n") 
  (setvar "CMDECHO" usercmd) 
  (princ) 
); end defun 
(princ) 
; 
; 
; 
 
 
;;;============================================================================== 
;;; Hatch - Creates separate hatch with several objects 
;;;=============================================================================== 
 
 
(defun c:mhatch (/ sset idx hnd cmdecho) 
  (setq cmdecho (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (setq sset 
         (ssget 
           '((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "OR>")) 
         ) 
  ) 
  (if sset 
    (progn 
      (command "UNDO" "_begin") 
      (setq idx (sslength sset)) 
      (while (>= (setq idx (1- idx)) 0) 
        (setq hnd (ssname sset idx)) 
        (command "_.hatch" "" "" "" hnd "") 
      ) 
      (command "UNDO" "_end") 
    ) 
  ) 
  (setvar "CMDECHO" cmdecho) 
  (princ) 
) 
 
;;;============================================================================== 
;;; Hatch- Quick pick hatch command 
;;;=============================================================================== 
 
(defun c:h (/ ss) 
    (setvar "cmdecho" 0) 
    (prompt "\n*** Select objects for Hatch & press [Enter] ") 
    (if (and 
            (setq ss (ssget)) 
            (> (sslength ss) 0) 
        ) 
        (command "hatch" "" "" "" ss "") 
    ) 
    (princ) 
) 
 
 
 
 
;;;============================================================================== 
;;; Hatch - Matches the properties of existing hatches (sets only) 
;;;=============================================================================== 
 
;;  Match properties of hatch pattern selected 
;;  Set system variables to match 
(defun c:hs (/ ent elist lay colr) 
  (if (setq ent (entsel)) 
    (progn 
      (setq elist (entget (car ent))) 
      (if (= (cdr (assoc 0 elist)) "HATCH") 
        (progn 
          (command "_undo" "_begin") 
          (setq lay (cdr (assoc 8 elist))) 
          (setq colr (cdr (assoc 62 elist))) 
          (setvar "hpname" (cdr (assoc 2 elist))) 
          (setvar "hpang" (cdr (assoc 52 elist))) 
          (if (or (= (substr (getvar "hpname") 1 2) "_U") 
                  (= (substr (getvar "hpname") 1 1) "U") 
              ) 
            (progn 
              (if (= (cdr (assoc 78 elist)) 2) 
                (setvar "hpdouble" 1) 
              ) 
              (if (= (cdr (assoc 78 elist)) 1) 
                (setvar "hpdouble" 0) 
              ) 
              (setvar "hpspace" (cdr (assoc 41 elist))) 
            ) 
            (setvar "hpscale" (cdr (assoc 41 elist))) 
          ) 
          (command "_layer" "s" lay "") 
          (if (null colr) 
            (setvar "cecolor" "256") 
            (setvar "cecolor" (itoa (cdr (assoc 62 elist)))) 
          ) 
          (command "_undo" "_end") 
          (if c:r 
            (c:r) 
            (redraw) 
          ) 
        ) 
        (prompt "\nSelection is not a hatch") 
      ) 
    ) 
    (prompt "\nNothing selected") 
  ) 
  (princ) 
) 
 
;;;=================================================================================== 
;;;Hatch - Matches existing hatch and allows user to pick new object 
;;;=================================================================================== 
 
 
(defun c:mh (/ ocol olay col ent lay hat sca rot po) 
  (setq ocol (getvar "cecolor")) 
  (setq olay (getvar "clayer")) 
  (setq oosn (getvar "osmode")) 
 
  (setvar "osmode" 0) 
  (if (setq ent (entsel "\nSelect a hatch pattern to copy.")) 
    (progn 
      (setq ent (entget (car ent))) 
      (if (= (cdr (assoc 0 ent)) "HATCH") 
   (progn 
     (setq lay (cdr (assoc 8 ent))) 
     (setq hat (cdr (assoc 2 ent))) 
     (setq sca (cdr (assoc 41 ent))) 
     (setq rot (cdr (assoc 52 ent))) 
     (setq rot (* rot (/ 180 pi))) 
     (setq col (cdr (assoc 62 ent))) ; may return nil 
     (cond 
       ((or (= col "BYLAYER") (= col "BYBLOCK")) 
        (setvar "cecolor" col) 
       ) 
       ((= (type col) 'int) 
        (setvar "cecolor" (itoa col)) 
       ) 
     ) 
     (command "layer" "s" lay "") 
     (initget "s") ; this allows numbers to be entered 
     (setq   po 
       (getpoint "\nSelect Internal Point or (S)elect Objects:") 
     ) 
     (if (= (type po) 'list) 
       (command "-bhatch" po "p" hat sca rot "") 
 
       (if   (setq po (ssget)) ; allow one choice only 
         (command "-bhatch" "s" po "" "p" hat sca rot "") 
         (prompt "\nNothing selected.") 
       ) 
     ) 
   ) 
   (prompt "\nSelection was not a hatch.") 
      ) 
    ) 
    (prompt "\nNothing selected.") 
  ) 
  (setvar "clayer" olay) 
  (setvar "cecolor" ocol) 
  (setvar "osmode" oosn) 
  (princ) 
) 
 
;;;=================================================================================== 
;;; Hatch - 2-point hatch 
;;;=================================================================================== 
(DEFUN C:2PHATCH () 
  (SETVAR "CMDECHO" 0)   
  (SETQ 
    X1 (GETPOINT "\nPick 1st corner:") 
    Y2 (GETCORNER X1 
       "\nPick opposite corner: ") 
    LEN1 (DISTANCE X1 Y2) 
    ANG1 (ANGLE X1 Y2) 
    X2 (POLAR X1 0.0 
       (* LEN1 (COS ANG1))) 
    Y1 (POLAR Y2 PI 
       (* LEN1 (COS ANG1))) 
  ) 
  (command "_.hatch" "" "" "" "" "n" X1 X2 Y2 Y1 "close" "") 
  (SETVAR "CMDECHO" 1) 
  (PRINC) 
) 
 
;;;=================================================================================== 
;;; Hatch - 2-point circular 
;;;=================================================================================== 
 
(defun c:cdh ( ) 
  (command "osmode" "16") 
  (command "circle" "2p" pause pause) 
  (command)(command) 
  (command "Hatch" "" pause 0 "L" "" "erase" "P" "")   
  (command "osmode" "0") 
) 
;;;=================================================================================== 
;;; Hatch - Pick internal point 
;;;=================================================================================== 
(defun c:hI (/ sSet *error*) 
(defun *error* (msg) 
(setvar "cmdecho" 1) 
); end *error* 
(setvar "cmdecho" 0) 
(setq ent1 (getpoint "*** Select POINT for Hatch ")) 
(command "_.-bhatch" ent1 "" "") 
(while (= 1 (getvar "cmdactive")) 
(command pause) 
); end while 
(command "") 
(princ) 
)

[/sell]

eachy · 发表于 2013-5-30 13:55:48

wowan1314 发表于 2013-5-30 13:33
把它做成函数呢！这样算方便了！

以前写的一个函数，绘制Hatch，ea:init的意义搜索相关帖子，这个函数是根据图中已有的填充生成填充图例，其中用到了Vla方法生成填充
;;参数：
;;space 图例间距
;;pl 表 hatch - patternname 、color (truecolor)
;; Gradienthatch - gradientname 、 color1 、color2 (渐变填充)
;;pt 基点

游客，本帖隐藏的内容需要积分高于 30 才可浏览，您当前积分为 0

kele99kele · 发表于 2015-7-27 22:31:12

看不了啊，混明经的，晓东的分不够看，郁闷

账号		自动登录	找回密码
密码			立即注册

[求助] 如何用entmake 创建 hatch 实体？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分

评分

浏览过的版块