[编程交流] 文本间距Lisp例程

(defun c:daly (/ tHeight insPoint dtSet oldDisMode errFlag 
                sStr tAlignPt tAlignment disDelta dtList 
                oldStrDis hitStr alignList oldMinPt maxPt
         minPt oldAlign oldDirect)
 
 (vl-load-com) 
 (defun texAlign (item /)
   (if(= daly:Direct "Y")
     (progn
         (setq disDelta(- disDelta daly:strDis)); end setq 
     (vla-put-Alignment (car str) tAlignment) 
     (cond 
  ((= tAlignment 0) 
     (vla-put-InsertionPoint (car str) 
       (vlax-3D-Point(car insPoint) 
         (+ disDelta(cadr insPoint))(nth 2 insPoint))) 
   ) 
  ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
     (vla-put-TextAlignmentPoint (car str) 
       (vlax-3D-Point(car tAlignPt) 
         (+ disDelta(cadr tAlignPt))(nth 2 tAlignPt))) 
   ) 
  ((member tAlignment '(3 5)) 
   (princ "\nCan't align string with Aligned or Fit alignment ") 
   ) 
  ); end cond
); end progn
     (progn
     (setq disDelta(- disDelta daly:strDis)); end setq 
     (vla-put-Alignment (car str) tAlignment) 
     (cond 
  ((= tAlignment 0) 
     (vla-put-InsertionPoint (car str) 
       (vlax-3D-Point(-(car insPoint)disDelta)
         (cadr insPoint)(nth 2 insPoint))) 
   ) 
  ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
     (vla-put-TextAlignmentPoint (car str) 
       (vlax-3D-Point(-(car tAlignPt)disDelta)
         (cadr tAlignPt)(nth 2 tAlignPt))) 
   ) 
  ((member tAlignment '(3 5)) 
   (princ "\nCan't align string with Aligned or Fit alignment ") 
   ) 
  ); end cond
     ); end progn
   ); end if
   ); end of texAlign
 (if(not daly:Direct)(setq daly:Direct "Y"))
 (setq oldDirect daly:Direct)
 (if(not daly:Align)(setq daly:Align "H"))
 (setq oldAlign daly:Align)
 (if(not daly:disMode)(setq daly:disMode "S")) 
 (setq oldDisMode daly:disMode) 
 (if(not daly:strDis)(setq daly:strDis 4.167)) 
 (setq oldStrDis daly:strDis)
 (initget "Y X")
 (setq daly:Direct 
   (getkword 
     (strcat "\nSpecify alignment direction [X-axis/Y-axis] <"daly:Direct">: ")))
 (if(null daly:Direct)(setq daly:Direct oldDirect))
 (initget "H L C M R TL TC TR ML MC MR BL BC BR")
 (setq daly:Align 
   (getkword 
     (strcat "\nSpecify justification [Hitest string/Left/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR] <"daly:Align">: "))
alignList '(("L" 0)("C" 1)("R" 2)("M" 4)("TL" 6)("TC" 7)("TR" ("ML" 9)("MC" 10)("MR" 11)("BL" 12)("BC" 13)("BR" 14))
            ); end setq 
 (if(null daly:Align)(setq daly:Align oldAlign))
 (initget "S C") 
 (setq daly:disMode 
   (getkword 
     (strcat "\nSpecify distance between strings [standard/Custom] <"daly:disMode">: "))) 
 (if(null daly:disMode)(setq daly:disMode oldDisMode)) 
 (if(= daly:disMode "C") 
   (progn 
   (setq daly:strDis(getdist(strcat "\nSpecify Custom distance <"(rtos daly:strDis)">: "))) 
   (if(null daly:strDis)(setq daly:strDis oldStrDis)) 
   (princ(strcat "\nCustom distance is "(rtos daly:strDis))) 
    ); end progn 
   ); end if
 (while T
 (princ "\n<<< Select DText and press Enter or Esc to Quit >>> ") 
  (if 
    (setq dtSet(ssget '((0 . "TEXT")))) 
   (progn
     (if(= "Y" daly:Direct)
     (setq dtList(vl-sort(mapcar 
          '(lambda (x)(list x 
        (+(cadr(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-InsertionPoint x)))) 
                (cadr(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-TextAlignmentPoint x))))))) 
      (mapcar 'vlax-ename->vla-object 
                 (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dtSet)))))
          (function(lambda(a b)(>(cadr a)(cadr b))))))
(setq dtList(vl-sort(mapcar 
          '(lambda (x)(list x 
        (+(car(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-InsertionPoint x)))) 
                (car(vlax-safearray->list 
            (vlax-variant-value 
              (vla-get-TextAlignmentPoint x))))))) 
      (mapcar 'vlax-ename->vla-object 
                 (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dtSet)))))
          (function(lambda(a b)(<(cadr a)(cadr b))))))
      ); end if
  
    (setq hitStr(caar dtList))
     
     (if(/= "H" daly:Align)
(progn
  (vla-getBoundingBox hitStr 'oldMinPt 'MaxPt)
  (foreach lst alignList
             (if(=(car lst)daly:Align)
               (progn
                 (if 
                         (not 
                          (vl-catch-all-error-p 
                           (vl-catch-all-apply 'vla-put-Alignment(list hitStr(cadr lst)))))
                  (progn
                    (vla-getBoundingBox hitStr 'minPt 'maxPt)
                    (vla-move hitStr minPt oldMinPt)
                    ); end progn
                  ); end if
                 ); end progn
               ); end if
    ); end foreach
  ); end progn
); end if
                 
    (setq tHeight(vla-get-Height hitStr) 
          insPoint(vlax-safearray->list 
                    (vlax-variant-value 
                      (vla-get-InsertionPoint hitStr))) 
          tAlignPt(vlax-safearray->list 
                    (vlax-variant-value 
                      (vla-get-TextAlignmentPoint hitStr))) 
          tAlignment(vla-get-Alignment hitStr) 
          dtList(cdr dtList) 
          disDelta 0.0 
    ); end setq 
   (if(= daly:disMode "S")(setq daly:strDis(* 1.6668 tHeight))) 
     (foreach str dtList 
    (if 
  (not 
      (vl-catch-all-error-p 
           (vl-catch-all-apply 'texAlign (list str)))) 
      (princ) 
      (setq errFlag T) 
      ); end if 
  ); end foreach 
     (if errFlag(princ "\n<!> Some Entities on Locked Layer <!>")) 
 ); end progn 
   (princ "\nStrings isn't selected. ") 
   ); end if
   ); end while
   (princ) 
   ); end of dali
(princ "\nType DALY to Run ")

(if(=(cadr curDer) 0.0)                   (setq curAng (/ pi 2))                          (setq curAng                        (- pi                         (atan                          (/(car curDer)                            (cadr curDer)))))                  ); end if