关于VLISP程序中尺寸标注的问题.

龙龙仔

陈伯雄

龙龙仔

龙龙仔

陈伯雄

龙龙仔

;;;点表处理是有很多条件的,所以我只贴出标注尺寸的程序部份。
(defun C:DIMQ (/ EEE N NN NOS DIST1)
  
;| FOR X   
  (setq        QQ '((636.751 124.485 0.0)  ;点表
             (606.751 124.485 0.0)
             (576.751 124.485 0.0)
             (456.751 124.485 0.0)
             (426.751 124.485 0.0)
             (396.751 124.485 0.0)
             (366.751 124.485 0.0)
             (306.751 124.485 0.0)
             (276.751 124.485 0.0)
             (186.751 124.485 0.0)
             (156.751 124.485 0.0)
             (126.751 124.485 0.0)
             (96.751 124.485 0.0)
             (57.751 124.485 0.0)
            )
  )
  (setq PT1 '(636.751 174.485 0.0)) ;标注位置点
  (setq PT '(636.751 124.485 0.0)) ;基准点
  |;
  
;;; FOR Y--------------------------
  (setq        QQ '((-156.38 400.026 0.0) ;点表
             (-156.38 370.026 0.0)
             (-156.38 340.026 0.0)
             (-156.38 310.026 0.0)
             (-156.38 250.026 0.0)
             (-156.38 220.026 0.0)
             (-156.38 160.026 0.0)
             (-156.38 130.026 0.0)
             (-156.38 100.026 0.0)
             (-156.38 70.026 0.0)
             (-156.38 -49.026 0.0)
             (-156.38 -79.026 0.0)
             (-156.38 -109.026 0.0)
             (-156.38 -139.026 0.0)
             (-156.38 -169.026 0.0)
            )
  )
  (setq PT1 '(-106.38 400.026 0.0)) ;标注位置点
  (setq PT '(-156.38 400.026 0.0)) ;基准点
;;;-----------------------------------
  
  (defun RT ()
    (if        (>= NOS 3)
      (progn
        (setq EEE (entget (entlast)))
        (setq EEE (subst (cons 1
                               (strcat (rtos (abs DIST1))
                                       "*"
                                       (rtos NOS)
                                       "=<>"
                               )
                         )
                         (assoc 1 EEE)
                         EEE
                  )
        )
        (entmod EEE)
      )
    )
  )

  (defun RR (N)
    (if        (= (car PT1) (car PT))
      (progn
        (setq DIST1 (- (car (nth (+ N 1) QQ)) (car (nth N QQ))))
        (setq NOS 1)
        (while
          (and (< N (- (length QQ) 2))
               (equal DIST1
                      (- (car (nth (+ N 2) QQ)) (car (nth (+ N 1) QQ)))
                      0.00001
               )
          )
           (setq NOS (1+ NOS))
           (setq N (1+ N))
        )
      )
      (progn
        (setq DIST1 (- (cadr (nth (+ N 1) QQ)) (cadr (nth N QQ))))
        (setq NOS 1)
        (while
          (and
            (< N (- (length QQ) 2))
            (equal DIST1
                   (- (cadr (nth (+ N 2) QQ)) (cadr (nth (+ N 1) QQ)))
                   0.00001
            )
          )
           (setq NOS (1+ NOS))
           (setq N (1+ N))
        )
      )
    )
    (if        (< NOS 3)
      (setq NN (- (+ N 2) NOS))
      (setq NN (+ N 1))
    )
  )

;;; MAIN PROGRAM
  (setq NN 0)
  (RR NN)
  (if (= (car PT1) (car PT))
    (command
      "_.dimlinear"
      (nth 0 QQ)
      (nth NN QQ)
      (list (/ (+ (car (nth 0 QQ)) (car (nth NN QQ))) 2)
            (cadr PT1)
            (last PT1)
      )
    )
    (command
      "_.dimlinear"
      (nth 0 QQ)
      (nth NN QQ)
      (list (car PT1)
            (/ (+ (cadr (nth 0 QQ)) (cadr (nth NN QQ))) 2)
            (last PT1)
      )
    )
  )
  (RT)
  (command "_.dimcontinue")
  (while (< NN (- (length QQ) 2))
    (RR NN)
    (command (nth NN QQ))
    (RT)
  )
  (command (nth (- (length QQ) 1) QQ))
  (command)
)

陈伯雄

附件中包括源程序和测试的结果。
这个程序充分表现了VLISP程序设计的特色，请各位参考、评论...

rainman