CAD Forums > Vertically Challenged

Surface labels on layer depending on label type

<< < (2/2)

Keith™:
Lisp is good ... of course you could also build one in C# relatively easily.

Rod:
Here is my progress.

SSLL to set surface label layer
Puts elevation labels on "Surf-" <surface name> "-Labels-Elev"
Puts slope labels on "Surf-" <surface name> "-Labels-Slope"
Puts contour labels on "Surf-" <surface name> " (which for me is the same as the surface)

If there isn't a layer one will be made with default properties

Thanks, Guys


--- Code: ---(defun C:setSurfaceLabelLayer (/ ss1 i len)
  (setq ss1 (ssget "X"
   '((0 . "AECC_SURFACE_SLOPE_LABEL,AECC_SURFACE_ELEVATION_LABEL,AECC_SURFACE_CONTOUR_LABEL_GROUP"))
    ) ;_ end of ssget
  ) ;_ end of setq
  (setq i 0)
  (if (and ss1 (> (setq len (sslength ss1)) 0))
    (while (< i len)
      (setSurfaceLabelLayer (ssname ss1 i))
      (setq i (1+ i))
    ) ;_ end of while
  ) ;_ end of if
  (princ)
) ;_ end of defun

(defun c:ssll ()
  (C:setSurfaceLabelLayer)
) ;_ end of defun

(defun setSurfaceLabelLayer (en / eList enType obj surf surfName)
  (setq elist (entget en))
  (setq enType (cdr (assoc 0 elist)))
  (setq obj  (vlax-ename->vla-object en)
surf (getProperty obj 'Surface)
  ) ;_ end of setq
  (if surf
    (progn
      (setq surfName
     (vlax-get-property surf 'Name)
      ) ;_ end of setq
    ) ;_ end of progn
  ) ;_ end of if
  (cond
    ((= enType "AECC_SURFACE_SLOPE_LABEL") (setq newlayer (strcat "Surf-" surfName "-Labels-Slope")))
    ((= enType "AECC_SURFACE_ELEVATION_LABEL") (setq newlayer (strcat "Surf-" surfName "-Labels-Elev")))
    (T (setq newlayer (strcat "Surf-" surfName)))
  ) ;_ end of cond
  (makeLayer newLayer)
  (setProperty obj 'Layer newlayer)
) ;_ end of defun

(defun getProperty (object prop / result)
  (vl-catch-all-apply
    (function
      (lambda ()
(setq result
       (vlax-get-property object prop)
) ;_ end of setq
      ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of vl-catch-all-apply
  result
) ;_ end of defun

(defun makeLayer (name)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
'(000 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(070 . 0)
(cons 002 name)
      ) ;_ end of list
    ) ;_ end of entmake
  ) ;_ end of if
) ;_ end of defun

(defun setProperty (oname property value)
  ;; Eg. (setproperty (Oname 'Radius 2.0))
  (if (vlax-property-available-p oname property T)
    (vlax-put-property oname property value)
  ) ;_ end of if
) ;_ end of defun

(princ "\nUse ssll to set surface label layer ")


--- End code ---

MSTG007:
Nice Job Rod.... I can follow it! lol.

Navigation

[0] Message Index

[*] Previous page