关于矩形填充帮忙优化(已解决)

zhoupeng220

1. (defun c:rectc(/ tc_e tc_vlae tc_name tc_scle tc_ang tc_la tc_col pt1 pt2)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.             (setq tc_e(car(entsel"\n選擇填充源圖案:")))
   
5.             (setq tc_vlae   (vlax-ename->vla-object  tc_e);名稱
   
6.                   tc_name   (vla-get-patternname  tc_vlae);圖案名稱
   
7.                   tc_scle   (vla-get-patternscale tc_vlae);比例
   
8.                   tc_ang    (* 180(/ (vla-get-patternangle tc_vlae) pi));角度
   
9.                   tc_la     (vla-get-layer        tc_vlae);圖層
   
10.                   tc_col    (vla-get-color        tc_vlae);顏色
    
11.                   tc_ltype  (vla-get-linetype     tc_vlae));线型
    
12.             
    
13.   (setq pt1 (getpoint "\n指定矩形的兩點:"))        
    
14.   (setq pt2 (getcorner pt1))  
    
15.   (command "rectang" pt1 pt2)
    
16.   ;(setq pt1 (entlast))   ;刪除矩形程式碼
    
17.   ;(if (= tc_col 256)(setq tc_col (cdr(assoc 62(entget(tblobjname "layer" tc_la))))))
    
18.   (command "-hatch" "p" tc_name tc_scle tc_ang  "s"  (entlast) "" "")
    
19.   ;(entdel pt1)  ;刪除矩形程式碼
    
20.   (while (/= 0 (getvar "cmdactive")) (command pause))
    
21.   (vla-put-color (vlax-ename->vla-object (entlast)) tc_col)
    
22.   (vla-put-layer (vlax-ename->vla-object (entlast)) tc_la)
    
23.   (vla-put-linetype (vlax-ename->vla-object (entlast)) tc_ltype)
    
24.   (setq princtext (strcat "\n當前填充圖案:" tc_name))
    
25.   (princ princtext)
    
26.   (princ "\n矩形填充完成")
    
27.   (princ)
    
28. )

(defun c:rectc(/ tc_e tc_vlae tc_name tc_scle tc_ang tc_la tc_col pt1 pt2)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />             (setq tc_e(car(entsel"\n選擇填充源圖案:")))<br />             (setq tc_vlae   (vlax-ename->vla-object  tc_e);名稱<br />                   tc_name   (vla-get-patternname  tc_vlae);圖案名稱<br />                   tc_scle   (vla-get-patternscale tc_vlae);比例<br />                   tc_ang    (* 180(/ (vla-get-patternangle tc_vlae) pi));角度<br />                   tc_la     (vla-get-layer        tc_vlae);圖層<br />                   tc_col    (vla-get-color        tc_vlae);顏色<br />                   tc_ltype  (vla-get-linetype     tc_vlae));线型<br />             <br />   (setq pt1 (getpoint "\n指定矩形的兩點:"))        <br />   (setq pt2 (getcorner pt1))  <br />   (command "rectang" pt1 pt2)<br />   ;(setq pt1 (entlast))   ;刪除矩形程式碼<br />   ;(if (= tc_col 256)(setq tc_col (cdr(assoc 62(entget(tblobjname "layer" tc_la))))))<br />   (command "-hatch" "p" tc_name tc_scle tc_ang  "s"  (entlast) "" "")<br />   ;(entdel pt1)  ;刪除矩形程式碼<br />   (while (/= 0 (getvar "cmdactive")) (command pause))<br />   (vla-put-color (vlax-ename->vla-object (entlast)) tc_col)<br />   (vla-put-layer (vlax-ename->vla-object (entlast)) tc_la)<br />   (vla-put-linetype (vlax-ename->vla-object (entlast)) tc_ltype)<br />   (setq princtext (strcat "\n當前填充圖案:" tc_name))<br />   (princ princtext)<br />   (princ "\n矩形填充完成")<br />   (princ)<br /> )

两个问题，1.获取solid图案后，执行下一步会有问题。
                2.怎样优化成如果不选取填充，默认是上次的填充图案比例角度

在大神@xyp1964 的帮助下问题已经解决。附上优化后的代码。

alexmai

solid图案是属于特殊填充，一般要单独处理



;;;临时填充灰色实体墙
(defun c:h111 ()
  (setvar "osmode" 0)
  (prompt "\n灰色实体填充,指定内部点\n")
  (setq pt (getpoint))
  (setq clcc (getvar "cecolor"))
  (setvar "cecolor" "bylayer")
  (if (null (tblsearch "LAYER" "COLUMN"))
    (command "-LAYER" "M" "COLUMN" "C" 252 "" "" "")
    (setvar "CLAYER" "COLUMN")
  )
  (command "-bhatch" "A" "A" "Y" "" "p" "solid" pt "")
  (setvar "cecolor" clcc)
  (princ)
)




;;;快速矩形填充
(defun c:reh (/ pt1 pt2 width height)
  (setq clay (getvar "clayer"));;;记下当前图层
  (setq clcc (getvar "cecolor"));;;记下当前颜色
  (setq lay1 (tblsearch "layer" "B-Hatch"))
  (if (= lay1 nil)
      (entmake
    (list
      '(0 . "layer")
       '(100 . "AcDbSymbolTableRecord")
       '(100 . "AcDbLayerTableRecord")
       '(70 . 0)
       '(6 . "Continuous")
       '(62 . 2)
           (cons 2 "B-Hatch")
      )
    )
  );if
  (setq lay1 (tblsearch "layer" "B-新起间墙填充"))
  (if (= lay1 nil)
      (entmake
    (list
      '(0 . "layer")
       '(100 . "AcDbSymbolTableRecord")
       '(100 . "AcDbLayerTableRecord")
       '(70 . 0)
       '(6 . "Continuous")
       '(62 . 252)
           (cons 2 "B-新起间墙填充")
      )
    )
  );if
  (setvar "CLAYER" "B-新起间墙填充")
   (if (setq p1 (getpoint "\n矩形插入点："))
        (progn
           (setq p4 (getcorner p1 "\n对角点：")
                p2 (list (car p4) (cadr p1))
                p3 (list (car p1) (cadr p4))
           )
           (entmake
                (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        '(90 . 5)
                        '(62 . 256)
                        (cons 8 "B-Hatch")
                        (cons 10 p1)
                        (cons 10 p2)
                        (cons 10 p4)
                        (cons 10 p3)
                        (cons 10 p1)
                 )
           )
          (setvar "cecolor" clcc)
          (command "-bhatch" "DR" "h" "A" "A" "n" "g" "15" "" "O" "D" "L" "Y" "s" (entlast) "" "")
          (command "ERASE" (SSGET "x"  '((-4 . "<OR") (-4 . "<AND") (8 . "B-Hatch")  (62 . 256) (0 . "LWPOLYLINE") (-4 . "AND>") (-4 . "OR>"))) "")
          (setvar "clayer" clay)
       )
   );if
)

moranyuyan

alexmai 发表于 2024-8-20 20:36
solid图案是属于特殊填充，一般要单独处理

如何改成保留选取填充，在执行选取填充时若是按下空格表示默认是上次的填充图案比例角度。

伊偭

谢谢分享，好用