[编程交流] Lisp获取pline的长度

;; [url]http://www.cadtutor.net/forum/showthread.php?101221-Lisp-to-get-length-of-a-pline-and-dim-value-and-put-it-to-the-several-text-elements[/url]
 ;; step 1: User select the polyline
 ;; step 2: User select the dimension
 ;; step 3: User insert 2 values: value 1 and value 2
 ;; step 4: User pick a point were the 4 different separate text elements appears: 
 ;;    value 1; polyine length; (dimension measurement value/value2)+1; 5*pline length*(value1)^2
 ;;    the color of the text should depend from value1, so the text with the same value1 should have the same color.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; @see [url]https://www.theswamp.org/index.php?topic=32148.0[/url]
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; settings
(setq 
 text_height 10
 text_spacing 14  ;; vertical distance between the lines
)
(defun c:p ( / ss_pline pline_length ss_dim dim_measurement entitylist value1 value2 pt text1 text2 text3 text4 val3)
 (vl-load-com)
 ;; step 1: User select the polyline
 (princ "\nSelect Polyline: ")
 (setq ss_pline (ssget  ":S"  (list (cons 0 "LWPOLYLINE")) ))
 (setq pline_length (vla-get-length (vlax-ename->vla-object (ssname ss_pline 0))))
 ;; step 2: User select the dimension
 (princ "\nSelect Dim: ")
 (setq ss_dim (ssget  ":S" (list (cons 0 "DIMENSION")) ))     ;;    
 (setq entitylist (cdr (entget (ssname ss_dim 0))))
 (setq dim_measurement (cdr (assoc 42 entitylist) ))
 ;; step 3: User insert 2 values: value 1 and value 2
 (setq
   value1 (getint "\nValue1 (int): ")
   value2 (getreal "\nValue2 (float): ")
 )
 ;; step 4: User pick a point were the 4 different separate text elements appears: 
 (setq pt (getpoint "\nGet Point: "))
 
 ;; Make text
   ;; value 1
 (setq text1 (Text pt text_height (itoa value1)))
   ;; polyine length
 (setq text2 (Text (list (nth 0 pt) (- (nth 1 pt) text_spacing )) text_height (rtos pline_length)) )
   ;; (dimension measurement value/value2)+1
 (setq val3 (fix (+ 0.5 (+ 1 (/ (float dim_measurement) value2))) ))
 (setq text3 (Text (list (nth 0 pt) (- (nth 1 pt) (* 2 text_spacing) )) text_height (rtos val3)) )
   ;; 5*pline length*(value1)^2
 (setq val4 (* (* 5 pline_length) (expt value1 2) ) )
 (setq text4 (Text (list (nth 0 pt) (- (nth 1 pt) (* 3 text_spacing) )) text_height (rtos val4)) )
   
   ;; the color of the text should depend from value1
 (vla-put-Color (vlax-ename->vla-object text1) value1)
 (vla-put-Color (vlax-ename->vla-object text2) value1)
 (vla-put-Color (vlax-ename->vla-object text3) value1)
 (vla-put-Color (vlax-ename->vla-object text4) value1)
 
)

;; global vars, these will remember the last chosen values
(setq
 pickvalue1 0 
 pickvalue2 0 
)
;; 
(defun c:test ( / value1 value2 promprstring )
 (setq promprstring (strcat
   "\nEnter Value 1 <" (rtos pickvalue1) ">: "
 ))
 (setq value1 (getstring promprstring))
 (if (= value1 "")
   (progn)
   (setq pickvalue1 (atof value1))
 )
 (setq promprstring (strcat
   "\nEnter Value 2 <" (rtos pickvalue2) ">: "
 ))
 (setq value2 (getstring promprstring))
 (if (= value2 "")
   (progn)
   (setq pickvalue2 (atof value2))
 )
 (princ "\n")
 (princ pickvalue1)
 (princ " - ")
 (princ pickvalue2)
 (princ)
)