DAVIDA 发表于 2022-7-6 14:36:17

文本间距Lisp例程

我在互联网上搜索了一个LISP例程,它可以抓取单个文本的行,并将它们正确对齐并等距重新列出。
 
有谁知道LISP可以这样做或类似的东西,我可以编辑?

DAVIDA 发表于 2022-7-6 14:47:38

 
我在互联网上搜索了一个合适的LISP或类似的东西,但都没有用。实际上,web上有数千个LISP例程(许多都做相同的事情,甚至许多已经是AutoCAD命令)。我可能在某个地方错过了理想的一个,因为有这么多。
 
谢谢你的关注。

ASMI 发表于 2022-7-6 14:50:25

找到了一些:
 
(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 <"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 <"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 <"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 ")
 
我无法回答这周我什么时候有空。也许只在假日

DAVIDA 发表于 2022-7-6 14:59:16

这意味着要将该部分添加到lisp中吗
(我没有lisp方面的经验)

ASMI 发表于 2022-7-6 15:04:36

如果这也能用于多行文字,那就太棒了

DAVIDA 发表于 2022-7-6 15:11:50

asos2000 发表于 2022-7-6 15:18:54

ASMI
whats a great website you have.
refer to DALY.lsp its great lisp that im looking for
what about adding another option aligning to an object
see attached
avoiding the object direction
see http://www.cadtutor.net/forum/showthread.php?p=168328#post168328
post #14
 
thanx again for DALY

ASMI 发表于 2022-7-6 15:27:46

Hi. It's possible, but I havn't more time today. This code calculates angle in point of curve. May be you can to find and modify it and add an option? 'curDer' is First Derive in point specified.
 

(if(=(cadr curDer) 0.0)                   (setq curAng (/ pi 2))                        (setq curAng                        (- pi                       (atan                          (/(car curDer)                          (cadr curDer)))))                  ); end if
 
I can't to answer when I will to have free time at this week. Maybe at holydays only

asos2000 发表于 2022-7-6 15:29:54

is it mean adding that part to the lisp
(i have no experience with lisp)

yawdapaah 发表于 2022-7-6 15:39:30

it would be awesome if this could be used for mtext as well
页: [1]
查看完整版本: 文本间距Lisp例程