GRDRAW使用线型

Lisphk

1. ;;;   ----------- GrDraw eXension - Version 1.0 -----------
   
2. ;;;   Copyright (C) 2010 by ResourceCAD International
   
3. ;;;   Author:   K.E. Blackie
   
4. ;;;   
   
5. ;;;   
   
6. ;;;   RCI PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
   
7. ;;;   RESOURCECAD INTERNATIONAL SPECIFICALLY DISCLAIMS ANY
   
8. ;;;   IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR
   
9. ;;;   USE.  RESOURCECAD INTERNATIONAL DOES NOT WARRANT THAT THE OPERATION
   
10. ;;;   OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.
    
11. ;;;   
    
12. ;;;   
    
13. ;;;   ResouceCAD International
    
14. ;;;   http://www.resourcecad.com
    
15. ;;;   
    
16. ;;;   DESCRIPTION
    
17. ;;;   GrDraw eXtension draws linetypes representative of the linetype specified
    
18. ;;;   This does not including complex linetypes using text and shape modifiers,
    
19. ;;;   although those may be added in the future.
    
20. ;;;   
    
21. ;;;   USAGE
    
22. ;;;   (grdrawlinetype <point> <point> intColor "CENTER")
    
23. ;;;   i.e. (grdrawlinetype '(0 0 0) '(0 10 0) 2 "CENTER") will draw a yellow line
    
24. ;;;   from 0,0,0 to 0,10,0 with the linetype of CENTER
    
25. ;;;   
    
26. ;;;   
    
27. ;;;   May 04, 2010
    
28. ;;;   
    
29. ;;;   ------------------------------------------------------------
    
30. 
    
31. (defun grdrawlinetype (start end color linetype / elelist end firstelement linelength ltypedef ndx nend nstart numelements patlength start tmppoint)
    
32.   (if (setq ltypedef (tblsearch "ltype" linetype))
    
33.     (progn
    
34.       ;get the elements of the linetype
    
35.       (setq numelements (cdr (assoc 73 ltypedef))
    
36.             elelist (member (assoc 49 ltypedef) ltypedef)
    
37.       )
    
38.       ;calculate the pattern length
    
39.       (setq patlength 0 ndx 0)
    
40.       (repeat numelements
    
41.               (setq patlength (+ patlength (*(abs (cdr (nth ndx elelist)))(getvar "ltscale")))
    
42.               ndx (1+ ndx))
    
43.       )
    
44.       (setq linelength (distance start end))
    
45.       (setq firstelement (*(abs (cdr (nth 0 elelist)))(getvar "ltscale")))
    
46.       (if (< linelength patlength)
    
47.         (setq numelements 0
    
48.               elelist nil)
    
49.         (setq firstelement (/ (- (* (+ (-(/ linelength patlength)(fix(/ linelength patlength)))1) patlength)(- patlength firstelement))2.0))
    
50.       )
    
51.       ;draw the pattern
    
52.       (setq nstart start
    
53.             nend end)
    
54.       (while (and (> (distance nstart nend) 0) (> numelements 0))
    
55.         (setq ndx 0)
    
56.         (while (< ndx numelements)
    
57.           (if (< (cdr (nth ndx elelist)) 0)
    
58.             (progn
    
59.               (if (= (distance nstart nend) linelength)
    
60.                 (progn
    
61.                   (setq tmppoint (polar nstart (angle nstart nend) firstelement))
    
62.                         (if (> (distance nstart tmppoint) (distance nstart nend))
    
63.                     (setq nstart nend
    
64.                           ndx numelements)
    
65.                     (setq nstart tmppoint
    
66.                           ndx (+ ndx 1))
    
67.                         )
    
68.                 )
    
69.                 (progn
    
70.                         (setq tmppoint (polar nstart (angle nstart nend)(*(*(cdr (nth ndx elelist))-1)(getvar "ltscale"))))
    
71.                         (if (> (distance nstart tmppoint) (distance nstart nend))
    
72.                     (setq nstart nend
    
73.                           ndx numelements)
    
74.                     (setq nstart tmppoint
    
75.                           ndx (+ ndx 1))
    
76.                         )
    
77.                 )
    
78.               )
    
79.             )
    
80.             (progn
    
81.               (if (= (distance nstart nend) linelength)
    
82.                 (setq tmppoint (polar nstart (angle nstart nend) firstelement))
    
83.                 (setq tmppoint (polar nstart (angle nstart nend) (*(cdr (nth ndx elelist))(getvar "ltscale"))))
    
84.               )
    
85.               (if (> (distance nstart tmppoint) (distance nstart nend))
    
86.                 (setq tmppoint nend
    
87.                       ndx numelements)
    
88.                 (if (> (+ (distance nstart tmppoint)(abs (cdr (nth ndx elelist))))(distance nstart nend))
    
89.                   (setq tmppoint nend
    
90.                         ndx numelements)
    
91.                 )
    
92.               )
    
93.               (grdraw nstart tmppoint color)
    
94.               (setq nstart tmppoint)
    
95.               (setq ndx (+ ndx 1))
    
96.             )
    
97.           )
    
98.           (if (<= (distance nstart nend) 0)
    
99.             (setq ndx numelements)
    
100.           )
     
101.         )
     
102.       )
     
103.       (if (= numelements 0)
     
104.         (grdraw start end color)
     
105.       )
     
106.     )
     
107.     (grdraw start end color)
     
108.   )
     
109. )
     

;;;   ----------- GrDraw eXension - Version 1.0 -----------<br /> ;;;   Copyright (C) 2010 by ResourceCAD International<br /> ;;;   Author:   K.E. Blackie<br /> ;;;   <br /> ;;;   <br /> ;;;   RCI PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.<br /> ;;;   RESOURCECAD INTERNATIONAL SPECIFICALLY DISCLAIMS ANY<br /> ;;;   IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR<br /> ;;;   USE.  RESOURCECAD INTERNATIONAL DOES NOT WARRANT THAT THE OPERATION<br /> ;;;   OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.<br /> ;;;   <br /> ;;;   <br /> ;;;   ResouceCAD International<br /> ;;;   <a href=\"http://www.resourcecad.com\" target=\"_blank\">http://www.resourcecad.com</a><br /> ;;;   <br /> ;;;   DESCRIPTION<br /> ;;;   GrDraw eXtension draws linetypes representative of the linetype specified<br /> ;;;   This does not including complex linetypes using text and shape modifiers,<br /> ;;;   although those may be added in the future.<br /> ;;;   <br /> ;;;   USAGE<br /> ;;;   (grdrawlinetype <point> <point> intColor "CENTER")<br /> ;;;   i.e. (grdrawlinetype '(0 0 0) '(0 10 0) 2 "CENTER") will draw a yellow line<br /> ;;;   from 0,0,0 to 0,10,0 with the linetype of CENTER<br /> ;;;   <br /> ;;;   <br /> ;;;   May 04, 2010<br /> ;;;   <br /> ;;;   ------------------------------------------------------------<br /> <br /> (defun grdrawlinetype (start end color linetype / elelist end firstelement linelength ltypedef ndx nend nstart numelements patlength start tmppoint)<br />   (if (setq ltypedef (tblsearch "ltype" linetype))<br />     (progn<br />       ;get the elements of the linetype<br />       (setq numelements (cdr (assoc 73 ltypedef))<br />             elelist (member (assoc 49 ltypedef) ltypedef)<br />       )<br />       ;calculate the pattern length<br />       (setq patlength 0 ndx 0)<br />       (repeat numelements<br />               (setq patlength (+ patlength (*(abs (cdr (nth ndx elelist)))(getvar "ltscale")))<br />               ndx (1+ ndx))<br />       )<br />       (setq linelength (distance start end))<br />       (setq firstelement (*(abs (cdr (nth 0 elelist)))(getvar "ltscale")))<br />       (if (< linelength patlength)<br />         (setq numelements 0<br />               elelist nil)<br />         (setq firstelement (/ (- (* (+ (-(/ linelength patlength)(fix(/ linelength patlength)))1) patlength)(- patlength firstelement))2.0))<br />       )<br />       ;draw the pattern<br />       (setq nstart start<br />             nend end)<br />       (while (and (> (distance nstart nend) 0) (> numelements 0))<br />         (setq ndx 0)<br />         (while (< ndx numelements)<br />           (if (< (cdr (nth ndx elelist)) 0)<br />             (progn<br />               (if (= (distance nstart nend) linelength)<br />                 (progn<br />                   (setq tmppoint (polar nstart (angle nstart nend) firstelement))<br />                         (if (> (distance nstart tmppoint) (distance nstart nend))<br />                     (setq nstart nend<br />                           ndx numelements)<br />                     (setq nstart tmppoint<br />                           ndx (+ ndx 1))<br />                         )<br />                 )<br />                 (progn<br />                         (setq tmppoint (polar nstart (angle nstart nend)(*(*(cdr (nth ndx elelist))-1)(getvar "ltscale"))))<br />                         (if (> (distance nstart tmppoint) (distance nstart nend))<br />                     (setq nstart nend<br />                           ndx numelements)<br />                     (setq nstart tmppoint<br />                           ndx (+ ndx 1))<br />                         )<br />                 )<br />               )<br />             )<br />             (progn<br />               (if (= (distance nstart nend) linelength)<br />                 (setq tmppoint (polar nstart (angle nstart nend) firstelement))<br />                 (setq tmppoint (polar nstart (angle nstart nend) (*(cdr (nth ndx elelist))(getvar "ltscale"))))<br />               )<br />               (if (> (distance nstart tmppoint) (distance nstart nend))<br />                 (setq tmppoint nend<br />                       ndx numelements)<br />                 (if (> (+ (distance nstart tmppoint)(abs (cdr (nth ndx elelist))))(distance nstart nend))<br />                   (setq tmppoint nend<br />                         ndx numelements)<br />                 )<br />               )<br />               (grdraw nstart tmppoint color)<br />               (setq nstart tmppoint)<br />               (setq ndx (+ ndx 1)) <br />             )<br />           )<br />           (if (<= (distance nstart nend) 0)<br />             (setq ndx numelements)<br />           )<br />         )<br />       )<br />       (if (= numelements 0)<br />         (grdraw start end color)<br />       )<br />     )<br />     (grdraw start end color)<br />   )<br /> )<br />

HLCAD

大师，你这贴与主题不符，内容与上一贴是一样的

/db_自贡黄明儒_

HLCAD 发表于 2021-1-19 16:24
大师，你这贴与主题不符，内容与上一贴是一样的

可能还有一贴,弄混了

Lisphk

HLCAD 发表于 2021-1-19 16:24
大师，你这贴与主题不符，内容与上一贴是一样的

sorry，修正了，谢谢！