设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 如何改进，生成线上线下文字？
12下一页
返回列表 发新帖
查看: 3957|回复: 15

[已解答] 如何改进，生成线上线下文字？

[复制链接]
ou_y_x
发表于 2013-12-15 15:38:09 | 显示全部楼层 |阅读模式
原程序如下，点击生成平行于直线，并在直线上的文字；
如果希望文字在直线下，只需把 (setq p2 (polar p1 (+ (/ pi 2) ang) 50))  改成 (setq p2 (polar p1 (+ (/ pi 2) ang) -350)) ；

但我现在想实现的是：
有一对平行直线，距离不超过600（或某个值），
点击上直线，文字在直线上部；点击下直线，文字在直线下部；

不知道如何来判断所点击的直线，往上600的距离内，是否有与之平行的直线，以确定文字在直线上或下；
希望各位能指点一二。


(defun c:z(/ cm n1 p1 p2 s1 d1 d2 ang )
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0 )
   (if (=(tblobjname "STYLE" "TSSD_Rein") nil)
        (progn
        (entmake (list '(0 . "STYLE")
                       '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbTextStyleTableRecord")
                       '(2 . "TSSD_Rein")
                       '(70 . 0)
                       '(40 . 0)
                       '(41 . 0)
                       '(3 . "tssdeng.shx")
                       '(4 . "hztxt.shx")))))
  (setq n1 (entsel "\n生成文字"))
  (setq p1 (osnap (cadr n1) "nea"))
  (setq s1 (entget (car n1)))
  (setq d1 (cdr (assoc 10 s1)))
  (setq d2 (cdr (assoc 11 s1)))
  (setq ang (angle d1 d2))
  (if (= (cdr (assoc 0 s1)) "LINE")
    (progn
    (if (and (> ang (+ (/ pi 2) 0.02)) (<= ang (+ (* pi 1.5) 0.02)))
    (setq ang(- ang pi)))
    (setq p2 (polar p1 (+ (/ pi 2) ang) 50))   
    (entmake (list
               (cons 0 "TEXT")
               (cons 100 "AcDbText")
               (cons 1 "2%%13218")
               (cons 10 p2)
               (cons 40 300)
               (cons 50 ang)
               (cons 7 "TSSD_Rein")
               (cons 8 "TEXT-L")
               (cons 41 0.7)))))
(setvar "cmdecho" cm))

如何

相关帖子
回复

使用道具 举报

bai2000
发表于 2020-9-21 19:00:06 | 显示全部楼层
不错的程序，顶一下 希望能框选生成相同的文字
回复 支持 反对

使用道具 举报

edata
发表于 2013-12-16 22:53:18 | 显示全部楼层
本帖最后由 edata 于 2013-12-17 12:55 编辑
  2. (defun c:tt(/ ss1 ss2 en1 ptx pt1 p11 e p10 ang ptup ptdn en2 e2 e11 e10 en3 e3 e310 e311 )
  3.   
  4.   (if (setq en1(entsel "\n选择直线:"))
  5.     (progn
  6.       (setq ptx(cadr en1))
  7.       (setq pt1(osnap ptx "nea"))
  8.       (setq e(entget (car en1)))
  9.       (setq p10(cdr(assoc 10 e))
  10.             p11(cdr(assoc 11 e))
  11.             en1h(cdr(assoc 5 e))
  12.             ang (angle p10 p11))
  13.       (setq ptup(polar pt1 (+ ang (* pi 0.5)) 240)
  14.             ptdn(polar pt1 (+ ang (* pi 1.5)) 240))
  15.       (command "_.zoom" "non" ptup "non" ptdn)
  16.       (setq ss1(ssget "c" pt1 ptup '((0 . "line"))))
  17.       (setq ss2(ssget "c" pt1 ptdn '((0 . "line"))))
  18.       (princ"aa")
  19.       (princ (sslength ss1))
  20.       (princ"cc")
  21.       (princ (sslength ss2))
  22.       (while (setq en2(ssname ss1 0))
  23.         (setq e2(entget en2))
  24.         (if (/= (cdr(assoc 5 e2)) en1h)
  25.           (progn
  26.         
  27.         (setq e10 (cdr(assoc 10 e2))
  28.               e11 (cdr(assoc 11 e2)))
  29.         (and (= (inters p10 p11 e10 e11 nil) nil)(princ"up_par"))
  30.         ))
  31.         (setq ss1 (ssdel en2 ss1))
  32.         )
  33.       (while (setq en3(ssname ss2 0))
  34.         (setq e3(entget en3))
  35.         (if (/= (cdr(assoc 5 e3)) en1h)
  36.           (progn
  37.         
  38.         (setq e310 (cdr(assoc 10 e3))
  39.               e311 (cdr(assoc 11 e3)))
  40.         (and (= (inters p10 p11 e310 e311 nil)nil)(princ"dn_par"))
  41.         ))
  42.         (setq ss2 (ssdel en3 ss2))
  43.         )
  44.   
  45.   (command "_.zoom" "P")
  46.       ))
  47.   (princ)
  48. )
未整理，，思路是取得当前直线上的点的时候，计算该点固定距离上下点，通过zoom缩放，使之可见，然后用ssget的c参数活得该距离的图元，如果有且平行的直线，执行文字位置设置。
回复 支持 反对

使用道具 举报

ZZXXQQ
发表于 2013-12-17 08:24:52 | 显示全部楼层
  2. (defun c:z(/ cm n1 p1 p2 s1 d1 d2 ang )
  3.   (setq cm (getvar "cmdecho"))
  4.   (setvar "cmdecho" 0 )
  5.   (if (=(tblobjname "STYLE" "TSSD_Rein") nil) (progn
  6.    (entmake
  7.     (list
  8.      '(0 . "STYLE")
  9.      '(100 . "AcDbSymbolTableRecord")
  10.      '(100 . "AcDbTextStyleTableRecord")
  11.      '(2 . "TSSD_Rein")
  12.      '(70 . 0)
  13.      '(40 . 0)
  14.      '(41 . 0)
  15.      '(3 . "tssdeng.shx")
  16.      '(4 . "hztxt.shx")
  17.     )
  18.    )
  19.   ))
  20.   (setq n1 (entsel "\n生成文字"))
  21.   (setq p0 (cadr n1))
  22.   (setq p1 (osnap p0 "nea"))
  23.   (setq ang1 (angle p1 p0))
  24.   (setq s1 (entget (car n1)))
  25.   (setq d1 (cdr (assoc 10 s1)))
  26.   (setq d2 (cdr (assoc 11 s1)))
  27.   (setq ang (angle d1 d2))
  28.   (if (= (cdr (assoc 0 s1)) "LINE") (progn
  29.    (if (and (> ang (+ (/ pi 2) 0.02)) (<= ang (+ (* pi 1.5) 0.02)))
  30.    (setq ang(- ang pi)))
  31.    (setq p2 (polar p1 ang1 200))
  32.    (entmake
  33.     (list
  34.      (cons 0 "TEXT")
  35.      '(100 . "AcDbEntity")
  36.      (cons 8 "TEXT-L")
  37.      (cons 100 "AcDbText")
  38.      (cons 10 p2)
  39.      (cons 40 300)
  40.      (cons 1 "2%%13218")
  41.      (cons 50 ang)
  42.      (cons 41 0.7)
  43.      (cons 7 "TSSD_Rein")
  44.      '(71 . 0)
  45.      '(72 . 4)
  46.      (cons 11 p2)
  47.      '(210 0.0 0.0 1.0)
  48.      '(100 . "AcDbText")
  49.      '(73 . 0)
  50.     )
  51.    )
  52.   ))
  53.   (setvar "cmdecho" cm)
  54.   (princ)
  55. )
回复 支持 反对

使用道具 举报

ou_y_x
 楼主| 发表于 2013-12-18 11:39:27 | 显示全部楼层
ZZXXQQ 发表于 2013-12-17 08:24

版主厉害，
光标靠上则文字在上，光标靠下则文字在下。
回复 支持 反对

使用道具 举报

ou_y_x
 楼主| 发表于 2013-12-18 11:40:26 | 显示全部楼层
edata 发表于 2013-12-16 22:53
未整理，，思路是取得当前直线上的点的时候，计算该点固定距离上下点，通过zoom缩放，使之可见，然后用ssge ...

原来思路要这么复杂
回复 支持 反对

使用道具 举报

adc
发表于 2013-12-30 20:12:00 | 显示全部楼层
ZZXXQQ 发表于 2013-12-17 08:24

请问能不能让程序同时支持直线、多段线和块内的线
回复 支持 反对

使用道具 举报

cable2004
发表于 2013-12-30 21:27:00 | 显示全部楼层
最好能带上反应器
回复 支持 反对

使用道具 举报

ZZXXQQ
发表于 2013-12-31 07:47:41 | 显示全部楼层
adc 发表于 2013-12-30 20:12
请问能不能让程序同时支持直线、多段线和块内的线

其实可以支持一切可以取得最近点的实体。
去掉程序中有关直线部分即可。
回复 支持 反对

使用道具 举报

清风明月名字
发表于 2013-12-31 12:06:43 | 显示全部楼层
谢谢众位坛友代码分享！
回复 支持 反对

使用道具 举报

adc
发表于 2013-12-31 17:38:45 | 显示全部楼层
ZZXXQQ 发表于 2013-12-17 08:24

研究半天没弄懂，这样改了还是不行，请指教！
(defun c:z(/ cm n1 p1 p2 s1 d1 d2 ang )
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0 )
  (if (=(tblobjname "STYLE" "TSSD_Rein") nil) (progn
   (entmake
    (list
     '(0 . "STYLE")
     '(100 . "AcDbSymbolTableRecord")
     '(100 . "AcDbTextStyleTableRecord")
     '(2 . "TSSD_Rein")
     '(70 . 0)
     '(40 . 0)
     '(41 . 0)
     '(3 . "tssdeng.shx")
     '(4 . "hztxt.shx")
    )
   )
  ))
  (setq n1 (entsel "\n生成文字"))
  (setq p0 (cadr n1))
  (setq p1 (osnap p0 "nea"))
  (setq ang1 (angle p1 p0))
  (setq s1 (entget (car n1)))
  (setq d1 (cdr (assoc 10 s1)))
  (setq d2 (cdr (assoc 11 s1)))
  (setq ang (angle d1 d2))
;;  (if (= (cdr (assoc 0 s1)) "LINE") (progn
   (if (and (> ang (+ (/ pi 2) 0.02)) (<= ang (+ (* pi 1.5) 0.02)))
   (setq ang(- ang pi)))
   (setq p2 (polar p1 ang1 200))
   (entmake
    (list
     (cons 0 "TEXT")
     '(100 . "AcDbEntity")
     (cons 8 "TEXT-L")
     (cons 100 "AcDbText")
     (cons 10 p2)
     (cons 40 300)
     (cons 1 "2%%13218")
     (cons 50 ang)
     (cons 41 0.7)
     (cons 7 "TSSD_Rein")
     '(71 . 0)
     '(72 . 4)
     (cons 11 p2)
     '(210 0.0 0.0 1.0)
     '(100 . "AcDbText")
     '(73 . 0)
    )
   )
;;  ))
  (setvar "cmdecho" cm)
  (princ)
)
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-17 21:33 , Processed in 0.231444 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表