旋转文字以对齐线条乐筑天下 - Powered by Discuz! Archiver

motee-z 发表于 2022-7-6 11:34:18

;;Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))

(defun c:TextRotate2Angle (/ ss lst pt ang obj
            get_pt_and_angle )
(vl-load-com)

;;User selection of curve object
;;return pick point & average angle of curve at pick point
(defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
(if (and (setq ent (entsel prmpt))
         (not (vl-catch-all-error-p
               (setq pt (vl-catch-all-apply
                           'vlax-curve-getClosestPointTo
                           (list (car ent) (cadr ent))
                        )
               )
            )
         )
   )
(progn
   (setq ent(car ent)
         p@pt (vlax-curve-getParamAtPoint ent pt)
         parA (max 0.0 (- p@pt 0.05))
         parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
         ang (angle (vlax-curve-getPointAtParam ent parA)
                     (vlax-curve-getPointAtParam ent ParB)
            )
   )
   (list pt ang)
)
)
)

;;Get Text to align & object to alignment angle
;;Text is not moved, just rotated to the alignment angle
;;Object must have curve data
(prompt "\nSelect text object to align.")
(if (and (or (setq ss(ssget "_+.:E:S" '((0 . "Text,Mtext"))))
         (prompt "\n**No Text object selected.**"))
      (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
         (prompt "\n**Missed or no curve data for object."))
   )
(progn
(setq pt(car lst)
      ;; ang (FixTextAngle (cadr lst))
      ang (cadr lst)
      obj (vlax-ename->vla-object (ssname ss 0))
)
(vla-put-rotation Obj ang)
)

)
(princ)
)

CAB 发表于 2022-7-6 11:37:39

谢谢你，出租车

motee-z 发表于 2022-7-6 11:42:35

驾驶室
thanx表示大Lisp程序
有一条评论
尝试将文本对齐到两行，一行从右向左绘制，第二行从左向右绘制

将该选项添加到lisp中怎么样
1-与对象的角度（如果需要，在另一个方向上使用文本，我将使用角度=180）。
2-文本和对象之间的Gab。
见附件
Thanx公司

asos2000 发表于 2022-7-6 11:45:45

您遇到的问题是，一条线看起来是270度或90度，但偏移量非常小。
该版本对这些角度有公差。现在对你有用吗？
;;Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))

(defun c:TextRotate2Angle (/ ss lst pt ang obj
            get_pt_and_angle )
(vl-load-com)

;;User selection of curve object
;;return pick point & average angle of curve at pick point
(defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
(if (and (setq ent (entsel prmpt))
         (not (vl-catch-all-error-p
               (setq pt (vl-catch-all-apply
                           'vlax-curve-getClosestPointTo
                           (list (car ent) (cadr ent))
                        )
               )
            )
         )
   )
(progn
   (setq ent(car ent)
         p@pt (vlax-curve-getParamAtPoint ent pt)
         parA (max 0.0 (- p@pt 0.05))
         parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
         ang (angle (vlax-curve-getPointAtParam ent parA)
                     (vlax-curve-getPointAtParam ent ParB)
            )
   )
   (list pt ang)
)
)
)

;;Get Text to align & object to alignment angle
;;Text is not moved, just rotated to the alignment angle
;;Object must have curve data
(prompt "\nSelect text object to align.")
(if (and (or (setq ss(ssget "_+.:E:S" '((0 . "Text,Mtext"))))
         (prompt "\n**No Text object selected.**"))
      (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
         (prompt "\n**Missed or no curve data for object."))
   )
(progn
(setq pt(car lst)
      ;; ang (FixTextAngle (cadr lst))
      ang (cadr lst)
      obj (vlax-ename->vla-object (ssname ss 0))
)
(vla-put-rotation Obj ang)
(if (zerop (vla-get-Alignment obj))
   (vla-put-InsertionPoint obj (vlax-3d-point pt))
   (vla-put-textalignmentpoint obj (vlax-3d-point pt))
)
)

)
(princ)
)

CAB 发表于 2022-7-6 11:48:07

至于您的选项请求，当选择偏移角度选项时，是否会应用间隙？
如果偏移角为负，你会怎么办？

CAB 发表于 2022-7-6 11:52:37

我无法选择文本

要求输入文本字符串，但我无法选择文本。

asos2000 发表于 2022-7-6 11:54:49

此版本仅允许用户输入文本字符串。

我想你也想要这个选择。

CAB 发表于 2022-7-6 11:57:48

我认为不需要gap，但最好应用它（以防有人需要）
当我把文字添加到一个计划中时，文字应该在一个方向上，以便一起阅读，所以有时我想做否定的方向
我在一个帖子里看到了，但不记得我会搜索。

Thanx公司

asos2000 发表于 2022-7-6 12:01:02

我认为这是令人愉快的

（defun c:talon（/cWid cHei cStr tVrx cCur grDat stFlg cAng sPt cPt aPt bPt pt1 pt2 pt3 pt4 nTxt mPt xPt oldStr）（vl load com）（if（not（getenv“talon:tsize”））（setenv“talon:tsize”（rtos（getvar“TEXTSIZE”））））；结束if（if（not（getenv“talon:offset”））（setenv“talon:offset”（rtos（/（getvar“TEXTSIZE”）2）））；结束if（if（not talon:str）（setq talon:str“”）（setq oldStr talon:str）（princ（strcat“\nSize=”（getenv“talon:tsize”）”，Offset=”（getenv“talon:Offset”）”，talstart to settings。“）；结束strcat）；end princ（setq-talon:str（getstring T（strcat“\n指定文本：”））（if（=“”talon:str）（setq-talon:str oldStr））（if（/=talon:str“”）（progn（setq-tVrx（textbox（list（cons 1-talon:str）（cons 40（atof（getenv“talon:tsize”）））））actDoc（vla get ActiveDocument（vlax get acad object）））；结束setq（if（=1（getvar“TILEMODE”））（setq actSp（vla get ModelSpace actDoc））（setq actSp（vla get PaperSpace actDoc））；结束if（setq cWid（caadr tVrx）cHei（cadadr tVrx））；结束setq（if（setq cCur（entsel“\n选择曲线>”）（if（成员（cdr（assoc 0（entget（car cCur）））”（“LINE”“LWPOLYLINE”“POLYLINE”“CIRCLE”“ELLIPSE”“ARC”“SPLINE”））（progn（setq cCur（vlax ename->vla object（car cCur）））（while（and（=5（car（setq grDat（grread T 1）））（非stFlg））；end and（redraw）（if（='LIST（type（setq sPt（cadr grDat）））（progn（setq cPt（vlax curve getclosestpoint to cCur sPt）cAng（angle cPt sPt）aPt（polar cPt cAng（atof（getenv“talon:offset”））bPt（polar cPt cAng（+atof（getenv“talon:offset”）））（atof（getenv“talon:tsize”））pt1（polar aPt（+cAng（/pi 2））（polar aPt（-cAng（/cWid 2））pt2（polar aPt pi 2））（/cWid 2））pt3（极性bPt（-cAng（/pi 2））（/cWid 2））pt4（极性bPt（+cAng（/pi 2））（/cWid 2））；结束setq（GRVEC（列表3 pt1 pt2 3 pt2 pt3 3 pt3 pt4 3 pt4 pt1））；结束程序）；如果结束）；结束时（if（=3（car grDat））（progn（setq stFlg T nTxt（vla AddText actSp talon:str（vlax-3D-point’（0.0 0 0.0））（atof（getenv“talon:tsize”））tVrx（textbox（entget（entlast）））mPt（vlax-3D-point（mapcar’/（mapcar’+（car tVrx）（cadr tVrx））'（2.0 2.0 1.0）））xPt（vlax-3D-point（mapcar’/（mapcar’+（aPt bPt） '(2.0 2.0 1.0))) ); end setq（vla Move nTxt mPt xPt）（如果（和（>cAng 0）（</p>

ASMI 发表于 2022-7-6 12:05:08

页: 1 [2]

乐筑天下's Archiver