社区 › Auto Lisp › 查看方向（帮助）

AIberto 发表于 2022-7-5 23:05:42

 
谢谢，我做了属性块了。但没有插入任何图形。

AIberto 发表于 2022-7-5 23:08:28

 
您好，可以用这段代码画箭头弧吗？是李的。由edata修改。
 
 

;; Arc to Bulge-Lee Mac
;; c   - center
;; a1,a2 - start, end angle
;; r   - radius
;; Returns: (<vertex> <bulge> <vertex>)

(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
         (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)
;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
               )
   )
)
(vl-load-com)
(defun c:tt(/ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3)
(if(and (setq r(getdist "\nRadius:"));; Radius = text height
         (setq pt(getpoint "\nCenter:"));;Placement point
         )
   (progn
   (setq l(* 0.5 r))
   (setq w(/ l 3.0))
   (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
   (setq obj(vlax-ename->vla-object en))
   (setq arc_len(vla-get-arclength obj))
   (setq p1(vlax-curve-getstartpoint obj))
   (setq p2(vlax-curve-getPointAtDist obj (- arc_len l)))
   (setq p3(vlax-curve-getEndpoint obj))      
   (setq ang1(angle pt p2 ))
   (setq ang2 0)
   (setq bulge(cadr(LM:Arc->Bulge pt ang2 ang1 r)))
   (vla-delete obj)      
   (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 bulge)
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                     
                     (cons 10 p3)))
   )
   )
(princ)
)

hanhphuc 发表于 2022-7-5 23:11:58

也许你没有完全理解这个概念？
我告诉过你制作attrib块不需要代码。
1.使用命令绘制圆弧：arc
2.draw arrow命令：DIMARC
将其分解，然后移除一侧箭头
3.make 2 attrib Tag，对齐
4.将图纸另存为CW。dwg或ACW。图纸
5.放入有效的支持文件夹
然后加载lisp，运行。
 
正如大家所见，李的代码绘制弧已经有这么长的代码，我还是光年才能达到他的水平
这就是为什么我的概念很简单，只需插入attrib块
 
我的代码仍然有bug，但我很快就会修复。

AIberto 发表于 2022-7-5 23:14:39

 
您好，谢谢您的回复！李的代码已经修改，只输入“Radius”和　选择“插入点”，半径=文字高度。

AIberto 发表于 2022-7-5 23:17:17

 
嗨，hanhphuc，　这更完美，可以选择edata修改的箭头方向（左或右）（@mjtd.com）
 
;; Arc to Bulge-Lee Mac
;; c   - center
;; a1,a2 - start, end angle
;; r   - radius
;; Returns: (<vertex> <bulge> <vertex>)

(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
         (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)

;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )
(if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
               )
   )
)

(defun c:tt(/ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3 keys)
(or *sk_rad_jt001* (setq *sk_rad_jt001* 10.0))
(setq *sk_rad_jt001*(cond((getdist (strcat "\nRadius<" (rtos *sk_rad_jt001* 2 4) ">:")))(*sk_rad_jt001*)))
(princ (strcat "\rCurrent Radius<" (rtos *sk_rad_jt001* 2 4) ">:"))
(if(setq pt(getpoint "\nCenter:"))
   (progn
   (setq r *sk_rad_jt001*)
   (initget "L R _l r")      
   (setq keys(cond((getkword "\rDirection of arrow<L>: "))("l")))
   (setq l(* 0.5 r))
   (setq w(/ l 3.0))
   (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
   (setq obj(vlax-ename->vla-object en))
   (setq arc_len(vla-get-arclength obj))
   (setq p1(if (= keys "l") (vlax-curve-getstartpoint obj) (vlax-curve-getEndpoint obj)))
   (setq p2(vlax-curve-getPointAtDist obj (if (= keys "l") (- arc_len l) l)))
   (setq p3(if (= keys "l") (vlax-curve-getEndpoint obj)(vlax-curve-getstartpoint obj) ))      
   (setq ang1(angle pt p2 ))
   (setq ang2 (if (= keys "l") 0 pi ))
   (setq bulge(cadr(LM:Arc->Bulge pt (if (= keys "l") ang2 ang1 ) (if (= keys "l") ang1 ang2 ) r)))
   (vla-delete obj)      
   (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 (if (= keys "l") bulge (* -1.0 bulge) ))
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                     
                     (cons 10 p3)))
   )
   )
(princ)
)

hanhphuc 发表于 2022-7-5 23:19:42

请尝试下载此示例，arc by命令完全没有lisp。
ACW。图纸
AC.dwg
将其保存在支持路径中。
我很欣赏李的代码很酷一直都是很好的资源，我会一步一步地学习，在我能稳定行走之前我不会跳跃

AIberto 发表于 2022-7-5 23:22:30

很抱歉，谢谢你的帮助！

AIberto 发表于 2022-7-5 23:26:06

 
顺便说一句，我无法下载dwg文件，　你为什么不上传这个论坛？

hanhphuc 发表于 2022-7-5 23:30:11

也许论坛不允许直接链接？
https://www.dropbox.com/s/xkadpo5w3ypg60u/CW.dwg
https://www.dropbox.com/s/snfp52cotybyxe3/ACW.dwg
 
如果无法在此处下载，请将粘贴复制到浏览器。

AIberto 发表于 2022-7-5 23:33:00

 
不，链接可以！但是我不能下载。可能是网络问题。你可以在这里上传“zip”格式。

查看完整版本: 查看方向（帮助）