未对齐非线性长度乐筑天下 - Powered by Discuz! Archiver

suryacad 发表于 2022-7-5 22:20:26

未对齐非线性长度

大家好。
有相当多的LISP的网站上围绕线的长度，但我寻找LISP，可以把几何长度或列表长度旁边的所有选定的线，弧的，普林斯等。在图纸中它自己。
像这样的。
非常感谢。

suryacad 发表于 2022-7-5 22:36:29

找到了一个Lisp，它完成了我在这里寻找的叫做LengthText的东西，多亏了Lisp的创建者。
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/line-length-typing-lisp/td-p/2119240
使用它，但长度是在线条的起点提到的，形成一个杂乱使阅读困难。
关于如何修改lisp以使文本可以沿直线移动到中心，有什么指导吗？
;------------------------------------------------ LenghtOfObject ------------------------
(defun LenghtOfObject (obj / len)
(if (vl-catch-all-error-p (setq len (vl-catch-all-apply 'vlax-curve-getDistAtParam
(list obj (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)))))) nil len
)
)
;------------------------------------------------ c:LengthText ------------------------
(defun c:LengthText ( / *ModelSpace* sel)
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-acad-object))))
(setvar "errno" 0) ; when the user on ssget press Enter the errno is set to 52
(while (and (setq sel (ssget))(/= (getvar "errno") 52))
(if sel
(progn
   (mapcar (function (lambda (ent / obj olg stpt TxtObj next_pt)
      (setqObj (vlax-ename->vla-object ent))
      (if (setq olg (LenghtOfObject obj))
      (progn
         (setq stpt (vlax-curve-getStartPoint obj))
         (setq TxtObj (vla-addText *ModelSpace* (rtos olg 2 2) (vlax-3d-point stpt) (getvar"textsize"))) ;_ end of vla-addText
         (setq next_pt (if (= "AcDbArc" (vlax-get obj 'ObjectName))
            (vlax-curve-getendpoint obj); end point
            (vlax-curve-getPointAtParam obj (1+ (fix (vlax-curve-getParamAtPoint obj stpt))))
         ))
         (vla-put-Rotation TxtObj (angle stpt next_pt))
         (setq stpt (vla-get-InsertionPoint TxtObj))
         (vla-put-alignment TxtObj acAlignmentBottomLeft)
         (vla-put-TextAlignmentPoint TxtObj stpt)
      )
      (if (ssmemb ent sel)(ssdel ent sel))
      )
   ))(vl-remove-if-not '(lambda(x)(= (type x) 'ENAME)) (mapcar 'cadr (ssnamex sel))))
)
)
)
(princ)
)
;------------------------------------------------ c:LenghtText1 ------------------------
(defun c:LengthText1 ( / *ModelSpace* sel Obj )
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-acad-object))))
(setvar "errno" 0) ; when the user on ssget press Enter the errno is set to 52
(while (and (setq sel (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC"))))(/= (getvar "errno") 52))
(if sel
(progn
   (mapcar (function (lambda (ent / obj oname stpt TxtObj next_pt)
      (setqObj (vlax-ename->vla-object ent))
      (if (LenghtOfObject obj)
      (progn
         (setq oname (vlax-get obj 'ObjectName))
         (setq stpt (vlax-curve-getStartPoint obj))
         (setq TxtObj (vla-addText *ModelSpace* (strcat "%<\\AcObjProp Object(%<\\_ObjId "
            (vl-princ-to-string (vla-get-ObjectID obj))">%)."(if (= "AcDbArc" oname) "Arc" "")"Length \\f \"%lu2%pr2%ps[, mm]\">%")
            (vlax-3d-point stpt) (getvar"textsize"))
         ) ;_ end of vla-addText
         (setq next_pt (if (= "AcDbArc" oname)
            (vlax-curve-getendpoint obj); end point
            (vlax-curve-getPointAtParam obj (1+ (fix (vlax-curve-getParamAtPoint obj stpt))))
         ))
         (vla-put-Rotation TxtObj (angle stpt next_pt))
         (setq stpt (vla-get-InsertionPoint TxtObj))
         (vla-put-alignment TxtObj acAlignmentBottomLeft)
         (vla-put-TextAlignmentPoint TxtObj stpt)
      )
      (if (ssmemb ent sel)(ssdel ent sel))
      )
   ))(vl-remove-if-not '(lambda(x)(= (type x) 'ENAME)) (mapcar 'cadr (ssnamex sel))))
)
)
)
(princ)
)

hanhphuc 发表于 2022-7-5 22:44:25

为了分享，我提供了附加代码，然后你自己试试。
全部归功于作者

在例程中添加此函数

(defun vlax-curve-getMidPoint (obj / len)
(vlax-curve-getPointAtDist
obj
(* 0.5
   (vlax-get obj
(if (vlax-property-available-p obj (setq len "length"))
   len
   (strcat "arc" len)
   ) ;_ end of if
) ;_ end of vlax-get
   ) ;_ end of *
) ;_ end of vlax-curve-getPointAtDist
) ;_ end of defun

然后替换此vlax曲线getStartPoint

...
...
(setq oname (vlax-get obj 'ObjectName))
         (setq stpt (vlax-curve-getStartPoint obj))
         (setq TxtObj (vla-addText *ModelSpace* (strcat "%<\\AcObjProp Object(%<\\_ObjId "
            (vl-princ-to-string (vla-get-ObjectID obj))">%)."(if (= "AcDbArc" oname) "Arc" "")"Length \\f \"%lu2%pr2%ps[, mm]\">%")
...
...

更改为。。

...
(setq stpt (vlax-curve-getMidPoint obj))
...

stevesfr 发表于 2022-7-5 22:47:41

不，仍然将文本放在端点！

stevesfr 发表于 2022-7-5 23:00:12

啊哈。。。。。。。。。。LengthText1将文本放置在实体的中点，LengthText将文本放置在起始点！
希望这对大家都有帮助！

hanhphuc 发表于 2022-7-5 23:09:05

你好，stevestr，
前一个用于LengthText1，

对于LengthText，类似的只是查找和替换
it to vlax curve GetMiddle点

...
...
(if (setq olg (LenghtOfObject obj))
      (progn
         (setq stpt (vlax-curve-getStartPoint obj)) ;<---- this
         (setq TxtObj
...
...

例子：

;associative dimension "line"
(defun ldim (lin / p1 p2 mp sz)
;hanhphuc 14/10/2014
(mapcar 'set '(p1 p2) (mapcar ''((e) (cdr (assoc e (entget lin)))) '(10 11)))
(setq sz (* 0.05 (distance p1 p2)) mp (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2))
(vl-cmdf "_dimaligned" p1 p2 mp)
('((obj)
(mapcar
'(lambda (a b) (vlax-put obj a b))
'("Arrowhead1Type" "Arrowhead2Type"    "extensionlineextend"    "extensionlineoffset"
"TextHeight" "TextInside"    "VerticalTextPosition" "TextGap"
)
(list 19 19 0. 0. sz :vlax-true 1 sz)
)
(vlax-put-property obj 'TextFill :vlax-true)
)
(vlax-ename->vla-object (entlast))
)
) ;_ end of defun

测试后，您可以只分解，然后返回到行和长度文本

suryacad 发表于 2022-7-5 23:13:33

不为我对这个问题的无知感到骄傲
我试过了，但只通过这一页学会了将文本居中对齐
http://www.theswamp.org/index.php?topic=2359.0
但它只在同一点上更改了文本对齐方式。
六羟甲基三聚氰胺六甲醚。。。。看起来解决方案就在我面前，感谢这个论坛上的优秀人士，让我试试。我可能会大错特错

suryacad 发表于 2022-7-5 23:28:56

你是一个救生员。你的第一个帖子做得很好，非常感谢朋友。
这是根据您的说明和结果编辑的最终代码。

(defun c:test (/ var l ss)
(setq l '("CMDECHO" "OSMODE" "DIMTIH" "DIMTOH" "DIMASSOC")
var (mapcar 'getvar l)
) ;_ end of setq
(mapcar 'setvar l '(0 0 0 0 2))
(command "_UNDO" "be")
(if (setq ss (ssget ":L" '((0 . "LINE"))))
(mapcar 'ldim (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
) ;_ end of if
(command "_UNDO" "e")
(vl-cmdf "_erase" ss "")
(mapcar 'setvar l var)
(princ)
) ;_ end of defun

页: [1]

乐筑天下's Archiver

未对齐非线性长度