求编一个画指定宽度矩形并填充的LSP

Noangler

cq4920 发表于 2023-6-15 10:05

谢谢分享源码。

MZ_li

牛啊牛啊！大佬厉害

37902505

cq4920 发表于 2023-6-15 10:05

老大，这里有个问题，横矩形生成的文字是以长边来的，竖矩形生成的文字才是以短边来的，能不能改成不管横竖都是以短边来命名的？

cq4920

37902505 发表于 2023-6-15 15:14
老大，这里有个问题，横矩形生成的文字是以长边来的，竖矩形生成的文字才是以短边来的，能不能改成不管横 ...

     (defun c:rect (/ pt1 pt2 width height)
(if (setq pt1 (getpoint "\n指定插入点: "))
        (progn
  (setq pt2 (getcorner pt1 "指定对角点"))
  (command "RECTANG" pt1 pt2)
        (command "CHPROP" (entlast) "" "LA" "EQUIP_消防" "")        
        (command "-bhatch" "p" "stars"  10 180 "s" (entlast) "" "")
  (command "CHPROP" (entlast) ""  "LA" "EQUIP_消防填充" "")
              
        (setq k  (rtos (abs (- (car pt1) (car pt2))))
        n  (rtos (abs (- (cadr pt1) (cadr pt2)))))
(if (> n k)
     (setq n k)
)
                                                               
              (setq txt (strcat "XF" n " F"))
              (setq pt-xz-y (center-max-y pt1 pt2))
              (setq pt3 (list (car pt1) (cadr pt2)))  
        (entmake (list '(0 . "TEXT") (cons 1 txt) (cons 11 pt-xz-y) (cons 10 pt2)
                        (cons 40 150)(cons 62 3)(cons 72 1)(cons 73 1)))
        (command "CHPROP" (entlast) ""  "LA" "EQUIP_消防文字" "")
  )
)
)


(defun center-max-y (pt1 pt2)
(setq x-center (/ (+ (car pt1) (car pt2)) 2.0)
        y-max (max (cadr pt1) (cadr pt2)))
    (list x-center y-max))



有时候后会出错

37902505

cq4920 发表于 2023-6-15 20:43
(defun c:rect (/ pt1 pt2 width height)
(if (setq pt1 (getpoint "\n指定插入点: "))
         ...

这个不错了，只是都是以长边命名，不是以短边命名。

yefei812678

cq4920 发表于 2023-6-15 20:43
(defun c:rect (/ pt1 pt2 width height)
(if (setq pt1 (getpoint "\n指定插入点: "))
         ...

能不能弄一个，画完矩形后打开填充界面选择填充样式后直接填充  

yefei812678

cq4920 发表于 2023-6-15 10:05

能不能帮我改下这个 在你的基础上   我加个两个填充 能不能添加个选择


(defun c:tcc (/ pt1 pt2 width height)
  (if (setq pt1 (getpoint "\n指定插入点: "))
    (progn
      (setq pt2 (getcorner pt1 "指定对角点"))
      (command "RECTANG" pt1 pt2)
      (SETQ PT1 (ENTLAST))
      (command "-bhatch"
               "p"
               "平面_石材1_比例1【YBC】"
               0.5
               45
               "s"
               (entlast)
               ""
               ""
      )
      (command "-bhatch"
               "p"
               "立面_木饰面1_90度_比例600【YBC】"
               600
               90
               "s"
               (entlast)
               ""
               ""
      )
      (ENTDEL PT1)
    )
  )
)

xyp1964

1. (defun c:tt ()
   
2.   "画指定宽度矩形并填充"
   
3.   (setq ll (getdist "\n矩形长度<1200>: "))
   
4.   (or ll (setq ll 1200.))
   
5.   (setq ww (getdist "\n矩形宽度<300>: "))
   
6.   (or ww (setq ww 300.))
   
7.   (setq th (getdist "\n矩形字高<100>: "))
   
8.   (or th (setq th 100.))
   
9.   (setvar "hpname" "STARS")
   
10.   (setvar "HPSCALE" 10)
    
11.   (setvar "hpang" 0)
    
12.   (while (setq p0 (getpoint "\n中心点<退出>: "))
    
13.     (setq p1 (mapcar '+ p0 (list (* ll -0.5) (* ww -0.5)))
    
14.           p2 (mapcar '+ p0 (list (* ll 0.5) (* ww 0.5)))
    
15.     )
    
16.     (command "rectang" "non" p1 "non" p2)
    
17.     (setq s1 (entlast))
    
18.     (command "-hatch" "s" s1 "" "")
    
19.     (setq tx (strcat "XF" (rtos ww 2 0) " F"))
    
20.     (setq pt (mapcar '+ p0 (list 0 (+ (* ww 0.5) (* th 0.75)))))
    
21.     (command "text" "j" "mc" "non" pt th 0 tx)
    
22.   )
    
23.   (princ)
    
24. )

(defun c:tt ()<br />   "画指定宽度矩形并填充"<br />   (setq ll (getdist "\n矩形长度<1200>: "))<br />   (or ll (setq ll 1200.))<br />   (setq ww (getdist "\n矩形宽度<300>: "))<br />   (or ww (setq ww 300.))<br />   (setq th (getdist "\n矩形字高<100>: "))<br />   (or th (setq th 100.))<br />   (setvar "hpname" "STARS")<br />   (setvar "HPSCALE" 10)<br />   (setvar "hpang" 0)<br />   (while (setq p0 (getpoint "\n中心点<退出>: "))<br />     (setq p1 (mapcar '+ p0 (list (* ll -0.5) (* ww -0.5)))<br />           p2 (mapcar '+ p0 (list (* ll 0.5) (* ww 0.5)))<br />     )<br />     (command "rectang" "non" p1 "non" p2)<br />     (setq s1 (entlast))<br />     (command "-hatch" "s" s1 "" "")<br />     (setq tx (strcat "XF" (rtos ww 2 0) " F"))<br />     (setq pt (mapcar '+ p0 (list 0 (+ (* ww 0.5) (* th 0.75)))))<br />     (command "text" "j" "mc" "non" pt th 0 tx)<br />   )<br />   (princ)<br /> )

xyp1964

1. (defun c:tt ()
   
2.   "画指定宽度矩形并填充"
   
3.   (defun udist (bit kwd msg def bpt / inp)
   
4.    (if def
   
5.     (setq msg(strcat"\n"msg"<"(rtos def)">: ")
   
6.           bit(* 2(fix(/ bit 2)))
   
7.     )
   
8.     (setq msg(strcat"\n"msg": "))
   
9.   )
   
10.   (initget bit kwd)
    
11.   (setq inp(if bpt(getdist msg bpt)(getdist msg)))
    
12.   (if inp inp def)
    
13.   )
    
14.   (or ll (setq ll 1200.))
    
15.   (or ww (setq ww 300.))
    
16.   (or th (setq th 100.))
    
17.   (setq ll (Udist 7 "" "矩形长度<输入或鼠标直接量取>" ll nil))
    
18.   (setq ww (Udist 7 "" "矩形宽度<输入或鼠标直接量取>" ww nil))
    
19.   (setq th (Udist 7 "" "字高<输入或鼠标直接量取>" th nil))
    
20.   (setvar "hpname" "STARS")
    
21.   (setvar "HPSCALE" 10)
    
22.   (setvar "hpang" 0)
    
23.   (while (setq p0 (getpoint "\n中心点<退出>: "))
    
24.     (setq p1 (mapcar '+ p0 (list (* ll -0.5) (* ww -0.5)))
    
25.           p2 (mapcar '+ p0 (list (* ll 0.5) (* ww 0.5)))
    
26.     )
    
27.     (command "rectang" "non" p1 "non" p2)
    
28.     (setq s1 (entlast))
    
29.     (command "-hatch" "s" s1 "" "")
    
30.     (setq tx (strcat "XF" (rtos ww 2 0) " F"))
    
31.     (setq pt (mapcar '+ p0 (list 0 (+ (* ww 0.5) (* th 0.75)))))
    
32.     (command "text" "j" "mc" "non" pt th 0 tx)
    
33.   )
    
34.   (princ)
    
35. )

(defun c:tt ()<br />   "画指定宽度矩形并填充"<br />   (defun udist (bit kwd msg def bpt / inp)<br />    (if def<br />     (setq msg(strcat"\n"msg"<"(rtos def)">: ")<br />           bit(* 2(fix(/ bit 2)))<br />     )<br />     (setq msg(strcat"\n"msg": "))<br />   )<br />   (initget bit kwd)<br />   (setq inp(if bpt(getdist msg bpt)(getdist msg)))<br />   (if inp inp def)<br />   )<br />   (or ll (setq ll 1200.))<br />   (or ww (setq ww 300.))<br />   (or th (setq th 100.))<br />   (setq ll (Udist 7 "" "矩形长度<输入或鼠标直接量取>" ll nil))<br />   (setq ww (Udist 7 "" "矩形宽度<输入或鼠标直接量取>" ww nil))<br />   (setq th (Udist 7 "" "字高<输入或鼠标直接量取>" th nil)) <br />   (setvar "hpname" "STARS")<br />   (setvar "HPSCALE" 10)<br />   (setvar "hpang" 0)<br />   (while (setq p0 (getpoint "\n中心点<退出>: "))<br />     (setq p1 (mapcar '+ p0 (list (* ll -0.5) (* ww -0.5)))<br />           p2 (mapcar '+ p0 (list (* ll 0.5) (* ww 0.5)))<br />     )<br />     (command "rectang" "non" p1 "non" p2)<br />     (setq s1 (entlast))<br />     (command "-hatch" "s" s1 "" "")<br />     (setq tx (strcat "XF" (rtos ww 2 0) " F"))<br />     (setq pt (mapcar '+ p0 (list 0 (+ (* ww 0.5) (* th 0.75)))))<br />     (command "text" "j" "mc" "non" pt th 0 tx)<br />   )<br />   (princ)<br /> )