[编程交流] 插入符号以反映属性

(defun pdetl (et etl)
 (setvar "cmdecho" 0)
 (if (and (= (cdr (assoc '0 etl)) "INSERT")
   (or (= "CIR" (strcase (substr (cdr (assoc '2 etl)) 1 3)))
       (= "$CIR" (strcase (substr (cdr (assoc '2 etl)) 1 4)))
       (= "GPT" (strcase (cdr (assoc '2 etl))))
       (= "POINT_CROSS" (strcase (cdr (assoc '2 etl))))
       (= "GULLY" (strcase (cdr (assoc '2 etl))))
   )
     )
   (progn
     (setq px 0.0
    py 0.0
    pz 0.0
    pnum ""
    pcode ""
    phgt ""
    phgt2 ""
     )
     (setq px (cadr (assoc '10 etl)))
     (setq py (caddr (assoc '10 etl)))
     (setq pz (cadddr (assoc '10 etl)))
     (setq phgt2 (rtos pz 2 2))
     (setq etl (entget (setq et (entnext et))))
     (while (/= (cdr (assoc '0 etl)) "SEQEND")
(cond ((= "POINT_NUMBER" (strcase (cdr (assoc '2 etl)))) (setq pnum (cdr (assoc '1 etl))))
      ((= "POINT_CODE" (strcase (cdr (assoc '2 etl)))) (setq pcode (cdr (assoc '1 etl))))
      ((= "POINT_HEIGHT" (strcase (cdr (assoc '2 etl)))) (setq phgt (cdr (assoc '1 etl))))
      (t nil)
)
(setq etl (entget (setq et (entnext et))))
     )
     T
   )
   nil
 )
)
(defun flr (x y) x)
(defun fll (x y) x)
(defun nodigits        (s)
 ;; function
 ;; returns a string s without any digits - leaves on alpha chars
 (setq        l (strlen s)
p 1
r ""
 )
 (while (<= p l)
   (setq c (substr s p 1))
   (if        (not (isdigit c))
     (setq r (strcat r c))
   )
   (setq p (1+ p))
 )
 r
)
(defun isdigit (c)
 (if c
   (and (<= (ascii c) 57) (>= (ascii c) 48))
   nil
 )
)
(defun c:ptsym ()
 ;; insert Symbols for Points
 (if (setq ss (ssget))
   (progn (setq u 0)
   (setq numss (sslength ss))
   (while (/= numss u)
     (setq etl (entget (setq et (ssname ss u))))
     (setq u (1+ u))
     (if (= (cdr (assoc '0 etl)) "INSERT")
       (progn (if (pdetl et etl)
                (progn (princ (flr pnum 6))
                       (princ "   ")
                       (setq pcode (strcase (nodigits pcode)))
                       (princ (flr pcode 10))
                       (princ "...")
                       (setq p1 (trans (LIST PX PY) 0 1))
                       (cond ((or (= pcode "TELE") (= pcode "TPIT"))
                              (progn (command "-layer" "m" "S-COMMS_INFO" "")
                                     (command "insert" "pp" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((= pcode "EBOX")
                              (progn (command "-layer" "m" "S-ELEC_INFO" "")
                                     (command "insert" "EBOX" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((= pcode "ELP")
                              (progn (command "-layer" "m" "S-ELEC_INFO" "")
                                     (command "insert" "LIGHT" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((= pcode "EPIT")
                              (progn (command "-layer" "m" "S-ELEC_INFO" "")
                                     (command "insert" "EPIT" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((or (= pcode "PP") (= pcode "EP"))
                              (progn (command "-layer" "m" "S-ELEC_INFO" "")
                                     (command "insert" "PP" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((= pcode "GM")
                              (progn (command "-layer" "m" "S-GAS_INFO" "")
                                     (command "insert" "GM" "s" (getvar "userr4") p1 "")
                              )
                             )
                             ((= pcode "GV")
                              (progn (command "-layer" "m" "S-GAS_INFO" "")
                                     (command "insert" "GV" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "RWMH")
                              (progn (command "-layer" "m" "S-ROOFWATER_INFO" "")
                                     (command "insert" "RWMH" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "SIO")
                              (progn (command "-layer" "m" "S-SEWER_INFO" "")
                                     (command "insert" "SIO" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((or (= pcode "SMH") (= pcode "SM"))
                              (progn (command "-layer" "m" "S-SEWER_INFO" "")
                                     (command "insert" "SMH" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "GT")
                              (progn (command "-layer" "m" "S-STORM_INFO" "")
                                     (command "insert" "GT" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "KO")
                              (progn (command "-layer" "m" "S-STORM_INFO" "")
                                     (command "insert" "BLOB" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "SWGT")
                              (progn (command "-layer" "m" "S-STORM_INFO" "")
                                     (command "insert" "GRATE" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "SWIO")
                              (progn (command "-layer" "m" "S-STORM_INFO" "")
                                     (command "insert" "SWIO" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "SWMH")
                              (progn (command "-layer" "m" "S-STORM_INFO" "")
                                     (command "insert" "SWMH" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "TSP")
                              (progn (command "-layer" "m" "S-TRAFFIC_INFO" "")
                                     (command "insert" "TRAF" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "UKN")
                              (progn (command "-layer" "m" "S-UNKNOWN_INFO" "")
                                     (command "insert" "US " "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "UP")
                              (progn (command "-layer" "m" "S-UNKNOWN_INFO" "")
                                     (command "insert" "UP" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "FH")
                              (progn (command "-layer" "m" "S-WATER_INFO" "")
                                     (command "insert" "FH" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "TAP")
                              (progn (command "-layer" "m" "S-WATER_INFO" "")
                                     (command "insert" "TAP" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "WM")
                              (progn (command "-layer" "m" "S-WATER_INFO" "")
                                     (command "insert" "WM" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "WPIT")
                              (progn (command "-layer" "m" "S-WATER_INFO" "")
                                     (command "insert" "WATER" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "WV")
                              (progn (command "-layer" "m" "S-WATER_INFO" "")
                                     (command "insert" "WV" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "HOIST")
                              (progn (command "-layer" "m" "HOIST_INFO" "")
                                     (command "insert" "CHOIST" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "AIRCON")
                              (progn (command "-layer" "m" "AIRCON_INFO" "")
                                     (command "insert" "AIRCON" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((or (= pcode "BOL") (= pcode "BOLLARD"))
                              (progn (command "-layer" "m" "BOLLARD_INFO" "")
                                     (command "insert" "BLOB" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "FL")
                              (progn (command "-layer" "m" "FLOOR_INFO" "")
                                     (command "insert" "BLOB" "s" (getvar "userr4") p1 "")
                              )
                             )
                                 ((= pcode "*TR")
                              (progn (command "-layer" "m" "TREE_INFO" "")
                                     (command "insert" "TREE" "s" (getvar "userr4") p1 "")
                              )
                             )
                       )
                )
              )
       )
     )
   )
   )
 )
 (princ)
)

; Dynamically insert a tree based on civ3D point description 
; By Alan H Sep 2016
; version 2 read a csv file for non Civ3D users
;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
   (setq prp (strcase prp))
   (vl-some
      '(lambda ( x )
           (if (= prp (strcase (vla-get-propertyname x)))
               (progn
                   (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                   (cond (val) (t))
               )
           )
       )
       (vlax-invoke blk 'getdynamicblockproperties)
   )
)
;; CSV -> List  -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)
(defun LM:csv->lst ( str sep pos / s )
   (cond
       (   (not (setq pos (vl-string-search sep str pos)))
           (if (wcmatch str ""*"")
               (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
               (list str)
           )
       )
       (   (or (wcmatch (setq s (substr str 1 pos)) ""*[~"]")
               (and (wcmatch s "~*[~"]*") (= 1 (logand 1 pos)))
           )
           (LM:csv->lst str sep (+ pos 2))
       )
       (   (wcmatch s ""*"")
           (cons
               (LM:csv-replacequotes (substr str 2 (- pos 2)))
               (LM:csv->lst (substr str (+ pos 2)) sep 0)
           )
       )
       (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
   )
)
(defun dynamic_trees ( / obj obj2 raw inspt )
;(if (not LM:csv->lst)(load "ReadCSV-V1-3"))
;(if (not LM:setdynpropvalue)(load "set-dynamic-block-value"))
(setq layold (getvar "clayer"))
(if (not (tblsearch "LAYER" "EX_TREE"))
    (Command "-layer" "m" "EX_TREE" "c" 90 "EX_TREE" "LT" "Continuous" "EX_TREE" "")
    (setvar "clayer" "EX_TREE")
)
(setq ss (ssget "x" '((0 . "AECC_COGO_POINT"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq raw (vla-get-description obj))
(setq inspt (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'location))))
;RawDescription = "TR 5 1.5" replace tr as required add extra tree types also
; use space delimeted description - tree trunk spread
(if (wcmatch raw "TR*") 
(progn
(setq rawlist (LM:csv->lst raw " " 0))
(setq basedesc (nth 0 rawlist))
(setq spread (atof (nth 2 rawlist)))
(setq trunk (atof (nth 1 rawlist))) ; convert string
(if (= "TR" basedesc)
(progn
(command "-Insert" "TREEDYN" inspt 1 1 0)
(setq obj2 (vlax-ename->vla-object (entlast)))
(LM:setdynpropvalue obj2 "Trunk" trunk)
(LM:setdynpropvalue obj2 "Spread" spread)
) ;progn
) ; if
) ;progn
) ; if
) ; repeat
(setvar "clayer" layold)
(princ) ; exit quitely
) ;defun
(dynamic_trees)

(setq basedesc (nth 0 rawlist))
(setq spread (atof (nth 3 rawlist)))
(setq trunk (atof (nth 1 rawlist))) ; convert string