1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
| (defun c:MAJCL (
;/ elev ss i el
)
(vl-load-com)
(setq Valer (getvar "luprec"))
(setvar "luprec" 0)
(initget 1 "0.5 1 2 5 10 25 50 100")
(setq
elev (getkword
"\nSelect String for filter [0.5/1/2/5/10/25/50/100]: "
)
)
(setq
LayerCL (car
(entsel
"\nClick on a layer with contour lines to modify : "
)
)
)
(setq EntLay (entget LayerCL))
(setq LAY (cdr (assoc 8 EntLay)))
(setq nomcalc (strcat "_NB-MajorLine_" elev))
(initget 1 "Blue Green GRey Pink Red White Yellow Other")
(setq
ColorCalc
(getkword
"\nSelect a color for the layer [Blue/Green/GRey/Pink/Red/White/Yellow/Other]: "
)
)
(cond ((= ColorCalc "Blue")
(setq Color 141)
)
((= ColorCalc "Green")
(setq Color 91)
)
((= ColorCalc "GRey")
(setq Color 253)
)
((= ColorCalc "Pink")
(setq Color 211)
)
((= ColorCalc "Red")
(setq Color 241)
)
((= ColorCalc "White")
(setq Color 7)
)
((= ColorCalc "Yellow")
(setq Color 51)
)
((= ColorCalc "Other")
(setq Color 121)
)
)
(if (not (tblsearch "LAYER" nomcalc))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 nomcalc)
(cons 70 0)
(cons 62 Color)
(cons 370 -3)
(cons 6 "Continuous")
)
)
)
(if (setq ss (ssget "_X"
(list (cons 0 "LWPOLYLINE") (cons 8 LAY))
)
)
(repeat (setq i (sslength ss))
(setq
el (cdr
(assoc 38 (entget (setq e (ssname ss (setq i (1- i))))))
)
)
(if (equal (distof (rtos (rem el (distof elev)) 2 2)) 0.0 1e-6)
; at elevation that is a multiple of elev?
(vla-put-Layer (vlax-ename->vla-object e) nomcalc)
;(command "_.chprop" e "" "_layer" nomcalc "")
) ; if
) ; repeat
) ; if
(setvar "luprec" Valer)
(princ)
) |
Partager