标注增强倾斜

guangdonglbq · 发表于 2020-9-27 23:44

本帖最后由 guangdonglbq 于 2020-9-27 23:45 编辑

使用AutoCAD自带的倾斜功能时，标尺界线会倾斜显示，但标注文本始终垂直于尺寸线，整体看起来不是那么协调。使用本程序可使尺寸界线倾斜时，标注文本也倾斜相同角度。
易桥工具箱中的标注“增强倾斜”的功能，使用效果与本程序相同。

;;;标注增强倾斜
(defun DimensionEnhanceTilt(/ entdxf fbasiclineangle fjiajiao foutangle ftargetangle listdirectionpoint1 listdirectionpoint2 listfirstpoint listsecondpoint objectnth ssobjects strobjectname stroutangle)
;(BeginUndoGroup)
      (princ "\n选择对齐尺寸标注:")
      (while (setq ssObjects (ssget '((0 . "DIMENSION")))) ; 创建选择集 ssObjects
            (setq listDirectionPoint1 (getpoint "点取倾斜方向上的第一点："))
            (setq listDirectionPoint2 (getpoint  listDirectionPoint1 "\n点取倾斜方向上的第二点："))
            (setq fTargetAngle (angle listDirectionPoint1 listDirectionPoint2 ))
            (command "_.DIMEDIT" "O" ssObjects "" listDirectionPoint1 listDirectionPoint2 )

(setq ObjectNth 0)
(while (< ObjectNth (sslength ssObjects))
                     (setq strObjectName (ssname ssObjects ObjectNth))
                     (setq entDxf (entget strObjectName))

                     (setq       listFirstPoint (cdr (assoc 13 entDxf)))
                     (setq       listSecondPoint (cdr (assoc 14 entDxf))       )
                     (setq fBasicLineAngle (angle listSecondPoint listFirstPoint ))

   (setq entDxf (entget strObjectName))
                     (setq fJiaJiao (- fBasicLineAngle fTargetAngle))

                     (setq fOutAngle (- (RadToDegree fJiaJiao ) 90.0 ))

                     (if (> foutangle 180)
                              (setq foutangle (- foutangle 180))
                     )
                     (if (< foutangle -180 )
                              (setq foutangle (+ 180 foutangle)))
                     (if (< foutangle -90 )
                              (setq foutangle (+ 180 foutangle)))
                     ;;以上三句if语句可保证文字倾斜后，不出现错误，但未搞清楚不处理时的出错原因。

                     (setq strOutAngle (strcat "{\\Q" (rtos fOutAngle 2 4) ";<>}" )) ;文字倾斜组码(1 . {\\Q16;<>})

                     (entmod (subst (cons 1 strOutAngle)
                                                            (assoc 1 entDxf)
                                                            entDxf
                                                      )
                     )
                     (entupd strObjectName)

                     (setq ObjectNth (1+ ObjectNth))
)

(princ "\n选择对齐尺寸标注:")
      )
  ;(EndUndoGroup)
  (princ)
)

;;弧度转为角度
(defun RadToDegree(rad)
(/ (* rad 180.0) pi)
)

mokson · 发表于 2020-9-28 08:14

本帖最后由 mokson 于 2020-9-28 08:20 编辑

楼主大人辛苦了。感谢您！
但是如何使用，命令是什么？ RADTODEGREE？

xj6019 · 发表于 2020-9-28 08:58

不错，不错，严重支持.............

yoyoho · 发表于 2020-9-28 23:29

谢谢! guangdonglbq 分享程序!!!!!

guangdonglbq · 发表于 2020-9-29 15:45

mokson 发表于 2020-9-28 08:14
楼主大人辛苦了。感谢您！
但是如何使用，命令是什么？ RADTODEGREE？

(DimensionEnhanceTilt)

mokson · 发表于 2020-9-29 17:40

命令搞得太长了。

czb203 · 发表于 2020-9-29 18:13

不错，不错，严重支持........

panliang9 · 发表于 2023-12-18 15:59

今天发现这个很好用！

账号		自动登录	找回密码
密码			注册

[源码] 标注增强倾斜