if not found Layer & Text Style (Entmake)

sachindkini

Dear All,
Please Help me

I was created text style & layer if not found

1) text style (xyz) , layer (text) & same pline layer (text) around the text

2. 
   
3. ;;------------------------------------------------------------;;
   
4. ;;   Carpet Area Program         ;;
   
5. ;;  This Program Created area of pline (@ mm Drawing only)    ;;
   
6. ;;------------------------------------------------------------;;
   
7. (defun c:CA nil (c:CarpetArea))
   
8. (defun c:CarpetArea (/ *error* p5 p6 a b c d e f s)
   
9. (vl-load-com)
   
10. ;;------------------------------------------------------------;;
    
11. ;;                        please add                                 ;;
    
12. ;;                        Error Handler                       ;;
    
13. ;;------------------------------------------------------------;;
    
14. 
    
15. ;;---------                 entmake               ------------;;
    
16. ;;--------------- if not found Layer & Text Style ------------;;
    
17. ;;------------------ Create Layer & Text Style ---------------;;
    
18. ;; layer      = xyz
    
19. ;; text style = room
    
20. ;; pline layer around text = xyz
    
21.   
    
22. 
    
23. 
    
24. ;;------------------------------------------------------------;;
    
25. (if (and (setq s (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
    
26. (setq p5 (getpoint "\nWHERE TO PLACE TEXT: "))
    
27. )
    
28. ;;------------------------------------------------------------;;
    
29. (progn
    
30. (setq p5 (polar p5 pi 1250))
    
31. (setq p6 (polar p5 0 2500))
    
32. (command "._area" "_e" (ssname s 0))
    
33. (SETQ A (GETVAR "AREA"))
    
34. (setq f (* A 0.000010764))
    
35. (setq f (rtos f 2 2))
    
36. (SETQ f (strcat f " SQ. FT."))
    
37. (SETQ B (/ A 1000000))
    
38. (SETQ C (RTOS B 2 2))
    
39. (SETQ D "CARPET AREA")
    
40. (setq e (strcat "= " C " SQ.MT."))
    
41. (setq F (strcat "= " F))
    
42. ;;------------------------------------------------------------;;
    
43. (COMMAND "_TEXT" "_S" "room" "_f" P5 p6 "250" D
    
44. "_text" "" e
    
45. "_text" "" f
    
46. "_.rectangle"
    
47. (mapcar '+ P5 '(-165 440 0))
    
48. (mapcar '+ P6 '(165 -1045 0))
    
49. ) ; end command
    
50. ;;------------------------------------------------------------;;
    
51. );; End Progn
    
52. (princ "\n   ~¤~     ...Type "Ca" to Invoke...        ~¤~   ")
    
53. );; End IF
    
54. (princ)
    
55. ;; Exit Cleanly
    
56. );; End defun
    
57. ;;----------------------End Program --------------------------;;
    

<br /> ;;------------------------------------------------------------;;<br /> ;;   Carpet Area Program         ;;<br /> ;;  This Program Created area of pline (@ mm Drawing only)    ;;<br /> ;;------------------------------------------------------------;;<br /> (defun c:CA nil (c:CarpetArea))<br /> (defun c:CarpetArea (/ *error* p5 p6 a b c d e f s)<br /> (vl-load-com)<br /> ;;------------------------------------------------------------;;<br /> ;;                        please add                                 ;;<br /> ;;                        Error Handler                       ;;<br /> ;;------------------------------------------------------------;;<br /> <br /> ;;---------                 entmake               ------------;;<br /> ;;--------------- if not found Layer & Text Style ------------;;<br /> ;;------------------ Create Layer & Text Style ---------------;;<br /> ;; layer      = xyz<br /> ;; text style = room<br /> ;; pline layer around text = xyz<br />   <br /> <br /> <br /> ;;------------------------------------------------------------;;<br /> (if (and (setq s (ssget "_:S:E" '((0 . "LWPOLYLINE"))))<br /> (setq p5 (getpoint "\nWHERE TO PLACE TEXT: "))<br /> )<br /> ;;------------------------------------------------------------;;<br /> (progn<br /> (setq p5 (polar p5 pi 1250))<br /> (setq p6 (polar p5 0 2500))<br /> (command "._area" "_e" (ssname s 0))<br /> (SETQ A (GETVAR "AREA"))<br /> (setq f (* A 0.000010764))<br /> (setq f (rtos f 2 2))<br /> (SETQ f (strcat f " SQ. FT."))<br /> (SETQ B (/ A 1000000))<br /> (SETQ C (RTOS B 2 2))<br /> (SETQ D "CARPET AREA")<br /> (setq e (strcat "= " C " SQ.MT."))<br /> (setq F (strcat "= " F))<br /> ;;------------------------------------------------------------;;<br /> (COMMAND "_TEXT" "_S" "room" "_f" P5 p6 "250" D<br /> "_text" "" e<br /> "_text" "" f<br /> "_.rectangle"<br /> (mapcar '+ P5 '(-165 440 0))<br /> (mapcar '+ P6 '(165 -1045 0))<br /> ) ; end command<br /> ;;------------------------------------------------------------;;<br /> );; End Progn<br /> (princ "\n   ~¤~     ...Type "Ca" to Invoke...        ~¤~   ")<br /> );; End IF<br /> (princ)<br /> ;; Exit Cleanly<br /> );; End defun<br /> ;;----------------------End Program --------------------------;;<br />

Gu_xl

1. ;;;param : s table Name
   
2. (defun table (s / d r)
   
3.   (while (setq d (tblnext s (null d)))
   
4.     (setq r (cons (cdr (assoc 2 d)) r))
   
5.   )
   
6. )
   
7. example:
   
8. 1. (table  "style") return all text style name.
   
9. 2.  (table  "layer") return all layer name.
   

;;;param : s table Name<br /> (defun table (s / d r)<br />   (while (setq d (tblnext s (null d)))<br />     (setq r (cons (cdr (assoc 2 d)) r))<br />   )<br /> )<br /> example:<br /> 1. (table  "style") return all text style name.<br /> 2.  (table  "layer") return all layer name.<br />

sachindkini

回复 Gu_xl 的帖子

Dear sir,
thx for reply
Can u complicated my code, I will try u r code but error coming

ZZXXQQ

2. 
   
3. ;;------------------------------------------------------------;;
   
4. ;;   Carpet Area Program         ;;
   
5. ;;  This Program Created area of pline (@ mm Drawing only)    ;;
   
6. ;;------------------------------------------------------------;;
   
7. (defun c:CA nil (c:CarpetArea))
   
8. (defun c:CarpetArea (/ *error* p5 p6 a b c d e f s)
   
9. (vl-load-com)
   
10. ;;------------------------------------------------------------;;
    
11. ;;                        please add                                 ;;
    
12. ;;                        Error Handler                       ;;
    
13. ;;------------------------------------------------------------;;
    
14. 
    
15. ;;---------                 entmake               ------------;;
    
16. ;;--------------- if not found Layer & Text Style ------------;;
    
17. ;;------------------ Create Layer & Text Style ---------------;;
    
18. ;; layer      = xyz
    
19. ;; text style = room
    
20. ;; pline layer around text = xyz
    
21.   
    
22. 
    
23. 
    
24. ;;------------------------------------------------------------;;
    
25. (if (and (setq s (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
    
26. (setq p5 (getpoint "\nWHERE TO PLACE TEXT: "))
    
27. )
    
28. ;;------------------------------------------------------------;;
    
29. (progn
    
30. (setq p5 (polar p5 pi 1250))
    
31. (setq p6 (polar p5 0 2500))
    
32. (command "._area" "_e" (ssname s 0))
    
33. (SETQ A (GETVAR "AREA"))
    
34. (setq f (* A 0.000010764))
    
35. (setq f (rtos f 2 2))
    
36. (SETQ f (strcat f " SQ. FT."))
    
37. (SETQ B (/ A 1000000))
    
38. (SETQ C (RTOS B 2 2))
    
39. (SETQ D "CARPET AREA")
    
40. (setq e (strcat "= " C " SQ.MT."))
    
41. (setq F (strcat "= " F))
    
42. ;;------------------------------------------------------------;;
    
43. (setq oldlayer (getvar "CLAYER"))
    
44. (if (tblsearch "LAYER" "text")
    
45. (setvar "CLAYER" "text")
    
46. (command ".LAYER" "M" "text" "")
    
47. )
    
48. (if (tblsearch "STYLE" "room")
    
49. (princ)
    
50. (command ".STYLE" "room" "ROMANS" "" "0.7" "" "" "" "")
    
51. )
    
52. (COMMAND "_TEXT" "_S" "room" "_f" P5 p6 "250" D
    
53. "_text" "" e
    
54. "_text" "" f
    
55. "_.rectangle"
    
56. (mapcar '+ P5 '(-165 440 0))
    
57. (mapcar '+ P6 '(165 -1045 0))
    
58. ) ; end command
    
59. (setvar "CLAYER" oldlayer)
    
60. ;;------------------------------------------------------------;;
    
61. );; End Progn
    
62. (princ "\n   ~¤~     ...Type "Ca" to Invoke...        ~¤~   ")
    
63. );; End IF
    
64. (princ)
    
65. ;; Exit Cleanly
    
66. );; End defun
    
67. ;;----------------------End Program --------------------------;;
    

<br /> ;;------------------------------------------------------------;;<br /> ;;   Carpet Area Program         ;;<br /> ;;  This Program Created area of pline (@ mm Drawing only)    ;;<br /> ;;------------------------------------------------------------;;<br /> (defun c:CA nil (c:CarpetArea))<br /> (defun c:CarpetArea (/ *error* p5 p6 a b c d e f s)<br /> (vl-load-com)<br /> ;;------------------------------------------------------------;;<br /> ;;                        please add                                 ;;<br /> ;;                        Error Handler                       ;;<br /> ;;------------------------------------------------------------;;<br /> <br /> ;;---------                 entmake               ------------;;<br /> ;;--------------- if not found Layer & Text Style ------------;;<br /> ;;------------------ Create Layer & Text Style ---------------;;<br /> ;; layer      = xyz<br /> ;; text style = room<br /> ;; pline layer around text = xyz<br />   <br /> <br /> <br /> ;;------------------------------------------------------------;;<br /> (if (and (setq s (ssget "_:S:E" '((0 . "LWPOLYLINE"))))<br /> (setq p5 (getpoint "\nWHERE TO PLACE TEXT: "))<br /> )<br /> ;;------------------------------------------------------------;;<br /> (progn<br /> (setq p5 (polar p5 pi 1250))<br /> (setq p6 (polar p5 0 2500))<br /> (command "._area" "_e" (ssname s 0))<br /> (SETQ A (GETVAR "AREA"))<br /> (setq f (* A 0.000010764))<br /> (setq f (rtos f 2 2))<br /> (SETQ f (strcat f " SQ. FT."))<br /> (SETQ B (/ A 1000000))<br /> (SETQ C (RTOS B 2 2))<br /> (SETQ D "CARPET AREA")<br /> (setq e (strcat "= " C " SQ.MT."))<br /> (setq F (strcat "= " F))<br /> ;;------------------------------------------------------------;;<br /> (setq oldlayer (getvar "CLAYER"))<br /> (if (tblsearch "LAYER" "text")<br /> (setvar "CLAYER" "text")<br /> (command ".LAYER" "M" "text" "")<br /> )<br /> (if (tblsearch "STYLE" "room")<br /> (princ)<br /> (command ".STYLE" "room" "ROMANS" "" "0.7" "" "" "" "")<br /> )<br /> (COMMAND "_TEXT" "_S" "room" "_f" P5 p6 "250" D<br /> "_text" "" e<br /> "_text" "" f<br /> "_.rectangle"<br /> (mapcar '+ P5 '(-165 440 0))<br /> (mapcar '+ P6 '(165 -1045 0))<br /> ) ; end command<br /> (setvar "CLAYER" oldlayer)<br /> ;;------------------------------------------------------------;;<br /> );; End Progn<br /> (princ "\n   ~¤~     ...Type "Ca" to Invoke...        ~¤~   ")<br /> );; End IF<br /> (princ)<br /> ;; Exit Cleanly<br /> );; End defun<br /> ;;----------------------End Program --------------------------;;<br />

sachindkini

回复 ZZXXQQ 的帖子

Dear sir,
Thx for reply
great it's working thx lot