[编程交流] 带文字的自定义多段线

;; local defuns
(vl-load-com)
(defun run-dialog  (leng /)
 (setq fn (strcat (getvar "dwgprefix")
    (getvar "dwgname")
    "waterparams.dcl")
fd (open fn "w"))
 (mapcar
   (function
     (lambda (x)
(princ x fd)
(princ "\n" fd)
)
     )
   (list
     "water : dialog {label="Parameters";"
     "fixed_width_font=true;"
     ": edit_box{label="Street";"
     "fixed_width_font=true;"
     "key = "street";}"
     ": edit_box{label="Length";"
     "fixed_width_font=true;"
     (strcat "value=" (rtos leng 2 3) ";")
     "key = "leng";}"
     ": list_box {label="Math";"
     "fixed_width_font=true;"
     "key = "math";"
     "multiple_select = false;"
     "height = 3.6;"
     "allow_accept = true;"
     "}"
     ": list_box {label="Dia.";"
     "fixed_width_font=true;"
     "key = "dia";"
     "multiple_select = false;"
     "height = 3.6;"
     "allow_accept = true;"
     "}"
     "ok_cancel;"
     "}"
     )
   )
 (close fd)
 (princ)
 )
;; convert radians to degrees
(defun rtd (rad)
 (/ (* rad 180) pi)
)
;; main part
(defun C:PPW  (/ *error* ang cl cr curve dcl_id dia dia_list dia_val
 en ent fn fst info leng leng_val lpt lpt1 lpt2 mat math_list
 math_val mat_val osm pick pt snd str_val txh txst upt)
 (vl-load-com)
  (defun *error*  (msg)
    (if msg(princ msg))
    ;; stop any command
    (while (/= (getvar "cmdactive") 0) (command))
    ;;restore variables
    (if osm
      (setvar "osmode" osm))
    (if cl
      (setvar "clayer" cl))
    (if cr
      (setvar "cecolor" cr))
    (if txst
      (setvar "textstyle" txst))
    (if txh
      (setvar "textsize" txh))
    (command "._undo" "E")
)
(setq osm (getvar "osmode"))
 (setq cl (getvar "clayer"))
 (setq cr (getvar "cecolor"))
 (setq txst (getvar "textstyle"))
 (setq txh(getvar "textsize"))
(command "._undo" "BE")
 (setvar "osmode" 0)
 (setvar "textsize" 50.0)
 (while (setq ent (entsel "\nSelect pipe-line (or hit Enter to Exit): "))
   (if
     (member (strcase (cdr (assoc 0 (entget (car ent)))))
      (list "LWPOLYLINE" "SPLINE"))
      (progn
 (setq en (car ent))
 (setq curve (vlax-ename->vla-object en))
 (setq pt (vlax-curve-getclosestpointto en (cadr ent)))
 (setq leng (vlax-curve-getdistatparam en (vlax-curve-getendparam en)))
 (run-dialog leng )
 (if (not (setq dcl_id (load_dialog fn)))
   (exit))
 (if (not (new_dialog "water" dcl_id))
   (exit))
 (start_list "math")
 (mapcar 'add_list
  (mapcar 'vl-princ-to-string
   (setq math_list
   (list "AB" "CD" "EF" "GH"))))
 (end_list)
 (start_list "dia")
 (mapcar 'add_list
  (mapcar 'vl-princ-to-string
   (setq dia_list
   (list 100 200 300 400 500))))
 (end_list)
 (action_tile
   "accept"
   (strcat "(progn "
    "(setq str_val (get_tile "street"))"
    "(setq leng_val (get_tile "leng"))"
    "(setq math_val (atoi (get_tile "math")))"
    "(setq dia_val (atoi (get_tile "dia")))"
    "(done_dialog 1))")
   )
 (action_tile "cancel" "(done_dialog 0)")
 (setq pick (start_dialog))
 (unload_dialog dcl_id)
 (vl-file-delete fn)
 (if (and (= 1 pick) str_val leng_val math_val dia_val)
   (progn
        (setq fst (vl-princ-to-string str_val))
        (setq snd (rtos (atof leng_val)2 3))
        (setq mat (vl-princ-to-string (setq mat_val (nth math_val math_list))))
        (setq dia(vl-princ-to-string (setq dia_val (nth dia_val dia_list))))
(setq  ang (angle
     '(0 0 0)
     (trans
       (vlax-curve-getfirstderiv
         curve
         (vlax-curve-getparamatpoint curve pt)
       )
       0 1 t 
     )
   )
)
(setq label
 (strcat
   "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] "
   (itoa (vla-get-objectid curve))
   ">%).Length [url="file://\\f"]\\f[/url] "%lu2%pr3">%"
 )
 )
;;set text rotation angle to more readable:
(if (< (/ pi 2) ang (* pi 1.5))
 (setq ang (+ ang pi))
 )
(setq upt (polar pt (+ ang (/ pi 2)) (* (getvar "textsize") 1.5)))
(setq lpt (polar pt (- ang (/ pi 2)) (* (getvar "textsize") 1.5)))
(setq lpt1 (polar lpt (+ ang pi) (getvar "textsize")))
(setq lpt2 (polar lpt ang (getvar "textsize")))
(setq ang (rtd ang))
(setvar "cecolor" "bylayer")
(setvar "clayer" "1 Street")
(command "-mtext" "_non" upt "J" "MC" "H" 50.0 "R" ang "w" 0  fst "")      
(setvar "clayer" "2 Length")
(command "-mtext" "_non" pt "J" "MC" "H" 50.0 "R" ang "w" 0  label "")      
(setvar "clayer" "3 Mat")
  (command "-mtext" "_non" lpt1 "J" "MR" "H" 50.0 "R" ang "w" 0  mat "")   
(setvar "clayer" "4 Dia")
     (command "-mtext" "_non" lpt2 "J" "ML" "H" 50.0 "R" ang "w" 0  (strcat "%%c" dia) "")
   )
 )
     )
   )
   )
   (*error* nil)
 (princ)
 )
(princ "\n Start command with PPW")
(prin1)