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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [仿PKPM]标注线线间距
返回列表 发新帖
查看: 2184|回复: 10

[源码] [仿PKPM]标注线线间距

[复制链接]
尘缘一生
发表于 2018-1-6 15:35:40 | 显示全部楼层 |阅读模式
        很早以前写的代码，仿PKPM的，“线线间距”命令，就是选择一组平行线，标注出他们的间距，这也是【三领外挂】中的一个命令，发下源码，争取大家优化下，还有就是绘图比例的选择，我一直想去掉。        另外：有没有线线间距的其他代码？我没找到，如果有，希望大家给我链接，我需要这个功能强大些！


  1. ;;;ll-lsp开始===========================================================*
  2. ;;;【仿PKPM线线间距】DCL设置比例,选择平行一组直线，标准他们间距尺寸
  3. (defun c:ll (/ s p n a pt0 pt00 pt1 pt2 pt3 pt4 pt5 pt6 ang x1 x2 y1 y2 p1
  4.               dis ang1 nam e pt10 pt11 f bl ptp0 pt01
  5.             )
  6.   (if (or
  7.         (not dcl_id)
  8.         (< (setq dcl_id (load_dialog (ll-dcl)))
  9.           0
  10.         )
  11.       )
  12.     (setq dcl_id (load_dialog (ll-dcl)))
  13.   )
  14.   (if (not (new_dialog "ll1" dcl_id))
  15.     (exit)
  16.   )
  17.   (action_tile "tile0" "(setq pt1 $value)")
  18.   (action_tile "tile00" "(setq pt1 $value)(set_tile \"tile0\" $value)")
  19.   (action_tile "tile1"
  20.     "(setq pt1 100)(set_tile \"tile0\" \"100\")(done_dialog 1)"
  21.   )
  22.   (action_tile "tile2"
  23.     "(setq pt1 150)(set_tile \"tile0\" \"150\")(done_dialog 1)"
  24.   )
  25.   (action_tile "tile3"
  26.     "(setq pt1 200)(set_tile \"tile0\" \"200\")(done_dialog 1)"
  27.   )
  28.   (action_tile "tile4"
  29.     "(setq pt1 50)(set_tile \"tile0\" \"50\")(done_dialog 1)"
  30.   )
  31.   (action_tile "tile5"
  32.     "(setq pt1 40)(set_tile \"tile0\" \"40\")(done_dialog 1)"
  33.   )
  34.   (action_tile "tile6"
  35.     "(setq pt1 30)(set_tile \"tile0\" \"30\")(done_dialog 1)"
  36.   )
  37.   (action_tile "tile7"
  38.     "(setq pt1 20)(set_tile \"tile0\" \"20\")(done_dialog 1)"
  39.   )
  40.   (action_tile "tile8"
  41.     "(setq pt1 10)(set_tile \"tile0\" \"10\")(done_dialog 1)"
  42.   )
  43.   (action_tile "tile9"
  44.     "(setq pt1 5)(set_tile \"tile0\" \"5\")(done_dialog 1)"
  45.   )
  46.   (action_tile "accept" "(setq pt1 100)(done_dialog 1)")
  47.   (start_dialog)
  48.   (unload_dialog dcl_id)
  49.   (setvar "DIMLFAC" pt1)
  50.   (setq s (ssget))
  51.   (while (/= s nil)
  52.     (setq p (- (sslength s) 1))
  53.     (setq n 0)
  54.     (setq a (ssadd))
  55.     (while (<= n p)
  56.       (setq pt1 (entget (ssname s n)))
  57.       (if (or
  58.             (= "LINE" (cdr (assoc 0 pt1)))
  59.             (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  60.           )
  61.         (ssadd (ssname s n) a)
  62.       )
  63.       (setq n (+ n 1))
  64.     )
  65.     (setq p (- (sslength a) 1))
  66.     (setq n 0)
  67.     (while (<= n p)
  68.       (setq pt1 (entget (setq nam (ssname a n))))
  69.       (if (= n 0)
  70.         (progn
  71.           (if (= "LINE" (cdr (assoc 0 pt1)))
  72.             (progn
  73.               (setq pt2 (cdr (assoc 10 pt1)))
  74.               (setq pt3 (cdr (assoc 11 pt1)))
  75.             )
  76.           )
  77.           (if (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  78.             (progn
  79.               (setq pt2 (entnext nam))
  80.               (setq pt3 (entnext pt2))
  81.               (setq pt2 (entget pt2))
  82.               (setq pt3 (entget pt3))
  83.               (setq pt2 (cdr (assoc 10 pt2)))
  84.               (setq pt3 (cdr (assoc 10 pt3)))
  85.             )
  86.           )
  87.           (setq ang1 (angle pt2 pt3))
  88.           (setvar "SNAPANG" ang1)
  89.           (setq ang (+ ang1 (/ pi 2)))
  90.           (setq pt4 (polar pt2 ang 3))
  91.           (setq e (list pt2))
  92.         )
  93.       )
  94.       (if (> n 0)
  95.         (progn
  96.           (if (= "LINE" (cdr (assoc 0 pt1)))
  97.             (progn
  98.               (setq pt10 (cdr (assoc 10 pt1)))
  99.               (setq pt11 (cdr (assoc 11 pt1)))
  100.             )
  101.           )
  102.           (if (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  103.             (progn
  104.               (setq pt10 (entnext nam))
  105.               (setq pt11 (entnext pt10))
  106.               (setq pt10 (entget pt10))
  107.               (setq pt11 (entget pt11))
  108.               (setq pt10 (cdr (assoc 10 pt10)))
  109.               (setq pt11 (cdr (assoc 10 pt11)))
  110.             )
  111.           )
  112.           (setq ang1 (angle pt10 pt11))
  113.           (if (and
  114.                 (/= (abs (- ang ang1)) 0.0)
  115.                 (/= (abs (- ang ang1)) pi)
  116.               )
  117.             (progn
  118.               (setq pt10 (inters
  119.                            pt2
  120.                            pt4
  121.                            pt10
  122.                            pt11
  123.                            nil
  124.                          )
  125.               )
  126.               (setq e (append
  127.                         (list pt10)
  128.                         e
  129.                       )
  130.               )
  131.             )
  132.           )
  133.         )
  134.       )
  135.       (setq n (+ n 1))
  136.     )
  137.     (setq p (- (length e) 1))
  138.     (setq n 0)
  139.     (setq f (ssadd))
  140.     (while (< n p)
  141.       (setq pt0 (nth n e))
  142.       (setq pt1 (nth (+ n 1) e))
  143.       (setq pt5 (polar pt0 (- ang1 (* 0.25 pi)) 0.71))
  144.       (setq pt6 (polar pt0 (+ ang1 (* 0.75 pi)) 0.71))
  145.       (command "_.PLINE" pt5 "W" 0.45 "" pt6 "")
  146.       (ssadd (entlast) f)
  147.       (setq pt5 (polar pt0 ang1 10))
  148.       (setq pt6 (polar pt0 (+ ang1 pi) 4))
  149.       (command "_.PLINE" pt5 "W" 0 "" pt6 "")
  150.       (ssadd (entlast) f)
  151.       (if (= n 0)
  152.         (setq pt00 pt0)
  153.       )
  154.       (if (= n (- p 1))
  155.         (progn
  156.           (setq pt1 (nth p e))
  157.           (setq pt5 (polar pt1 (- ang1 (* 0.25 pi)) 0.71))
  158.           (setq pt6 (polar pt1 (+ ang1 (* 0.75 pi)) 0.71))
  159.           (command "_.PLINE" pt5 "W" 0.45 "" pt6 "")
  160.           (ssadd (entlast) f)
  161.           (setq pt5 (polar pt1 ang1 10))
  162.           (setq pt6 (polar pt1 (+ ang1 pi) 4))
  163.           (command "_.PLINE" pt5 "W" 0 "" pt6 "")
  164.           (ssadd (entlast) f)
  165.           (setq ptp0 pt1)
  166.           (command "_.PLINE" pt00 "W" 0 "" ptp0 "")
  167.           (ssadd (entlast) f)
  168.         )
  169.       )
  170.       (setq dis (distance pt1 pt0))
  171.       (setq y1 (nth 1 pt0))
  172.       (setq y2 (nth 1 pt1))
  173.       (setq x1 (nth 0 pt0))
  174.       (setq x2 (nth 0 pt1))
  175.       (if (> y1 y2)
  176.         (progn
  177.           (setq ang (angle pt1 pt0))
  178.           (setq pt01 (polar pt1 ang (/ dis 2)))
  179.         )
  180.       )
  181.       (if (< y1 y2)
  182.         (progn
  183.           (setq ang (angle pt0 pt1))
  184.           (setq pt01 (polar pt0 ang (/ dis 2)))
  185.         )
  186.       )
  187.       (if (= y1 y2)
  188.         (progn
  189.           (if (> x1 x2)
  190.             (progn
  191.               (setq ang (angle pt1 pt0))
  192.               (setq pt01 (polar pt1 ang (/ dis 2)))
  193.             )
  194.           )
  195.           (if (< x1 x2)
  196.             (progn
  197.               (setq ang (angle pt0 pt1))
  198.               (setq pt01 (polar pt0 ang (/ dis 2)))
  199.             )
  200.           )
  201.         )
  202.       )
  203.       (setq pt01 (polar pt01 (+ ang (/ pi 2)) 1))
  204.       (setq bl (getvar "DIMLFAC"))
  205.       (setq dis (rtos (* bl dis)))
  206.       (setq p1 (strlen dis))
  207.       (setq pt4 (polar pt01 ang p1))
  208.       (setq pt3 (polar pt01 (+ ang pi) p1))
  209.       (setvar "TEXTSTYLE" "STANDARD")
  210.       (command "TEXT" "J" "F" pt3 pt4 3.0 dis)
  211.       (ssadd (entlast) f)
  212.       (setq n (+ n 1))
  213.     )
  214.     (setvar "ORTHOMODE" 1)
  215.     (command "MOVE" f "" pt00 pause "")
  216.     (setvar "ORTHOMODE" 0)
  217.     (setvar "SNAPANG" 0)
  218.     (setq s (ssget))
  219.   )
  220. )
  221. ;;=====================================================*
  222. (defun ll-dcl (/ lst_str str file f)
  223.   (setq lst_str '(
  224.                    "ll1:dialog{"
  225.                    " label=\"你绘图的比例是？\";"
  226.                    " initial_focus=\"tile0\";"
  227.                    " :boxed_row{"
  228.                    "  label=\"The num=:\";"
  229.                    "  :edit_box{key=\"tile0\";value=\"100\";allow_accept=true;}"
  230.                    "  :slider{key=\"tile00\";fixed_widht=true;width=16;max_value=100;min_value=1;}"
  231.                    " }"
  232.                    " :boxed_radio_row{"
  233.                    "  label=\"Select\";"
  234.                    "  :radio_button{label=\"100\";key=\"tile1\";}"
  235.                    "  :radio_button{label=\"150\";key=\"tile2\";}"
  236.                    "  :radio_button{label=\"200\";key=\"tile3\";}"
  237.                    "  :radio_button{label=\"50\";key=\"tile4\";}"
  238.                    " }"
  239.                    " :boxed_radio_row{"
  240.                    "  :radio_button{label=\"40\";key=\"tile5\";}"
  241.                    "  :radio_button{label=\"30\";key=\"tile6\";}"
  242.                    "  :radio_button{label=\"20\";key=\"tile7\";}"
  243.                    "  :radio_button{label=\"10\";key=\"tile8\";}"
  244.                    "  :radio_button{label=\"5\";key=\"tile9\";}"
  245.                    " }"
  246.                    " ok_only;"
  247.                    "}"
  248.                  )
  249.   )
  250.   (setq file (vl-filename-mktemp "DclTemp.dcl"))
  251.   (setq f (open file "w"))
  252.   (foreach str lst_str
  253.     (princ "\n" f)
  254.     (princ str f)
  255.   )
  256.   (close f)
  257.   ;;返回
  258.   file
  259. )

  261. ;;;ll-lsp结束===========================================================*




"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

石井鱼
发表于 2018-1-9 19:00:16 | 显示全部楼层
没有看懂，不知道有啥用处
回复 支持 反对

使用道具 举报

e2002
发表于 2018-1-9 23:31:12 | 显示全部楼层
如果是一组平行线，直接 qdim 命令即可一次标注好间距，无需程序。

点评

尘缘一生
QDIM标注出的尺寸是没炸开的，而且，标注和图连在一起，不脱开，不理想。  发表于 2018-1-14 03:35
回复 支持 反对

使用道具 举报

fl202
发表于 2018-1-10 17:42:51 | 显示全部楼层
我是用di命令测量。有时候只需要知道距离即可，不需要标注出来，否则标注完了还要删掉。
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2018-5-9 22:40:13 | 显示全部楼层
代码更新，去除BUG，设置绘图比例

  1. ;;;==选择平行一组直线，标准他们间距尺寸==========================================*
  2. (defun c:ll (/ s p n a pt0 pt00 pt1 pt2 pt3 pt4 pt5 pt6 ang x1 x2 y1 y2 p1
  3.               dis ang1 nam e pt10 pt11 f ptp0 pt01
  4.             )
  5.   (sset)
  6.   (setq s (ssget))
  7.   (while (/= s nil)
  8.     (setq p (- (sslength s) 1))
  9.     (setq n 0)
  10.     (setq a (ssadd))
  11.     (while (<= n p)
  12.       (setq pt1 (entget (ssname s n)))
  13.       (if (or
  14.             (= "LINE" (cdr (assoc 0 pt1)))
  15.             (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  16.           )
  17.         (ssadd (ssname s n) a)
  18.       )
  19.       (setq n (+ n 1))
  20.     ) ;;;;;;;取得线性实体选择集a
  21.     (setq p (- (sslength a) 1))
  22.     (setq n 0)
  23.     (while (<= n p)
  24.       (setq pt1 (entget (setq nam (ssname a n))))
  25.       (if (= n 0)
  26.         (progn
  27.           (if (= "LINE" (cdr (assoc 0 pt1)))
  28.             (progn
  29.               (setq pt2 (cdr (assoc 10 pt1)))
  30.               (setq pt3 (cdr (assoc 11 pt1)))
  31.             )
  32.           )
  33.           (if (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  34.             (progn
  35.               (setq pt2 (entnext nam))
  36.               (setq pt3 (entnext pt2))
  37.               (setq pt2 (entget pt2))
  38.               (setq pt3 (entget pt3))
  39.               (setq pt2 (cdr (assoc 10 pt2)))
  40.               (setq pt3 (cdr (assoc 10 pt3)))
  41.             )
  42.           )
  43.           (setq ang1 (angle pt2 pt3))
  44.           (setvar "SNAPANG" ang1)
  45.           (setq ang (+ ang1 (/ pi 2)))
  46.           (setq pt4 (polar pt2 ang (* (getvar "DIMSCALE") 3.0)))
  47.           (setq e (list pt2))
  48.         )
  49.       )
  50.       (if (> n 0)
  51.         (progn
  52.           (if (= "LINE" (cdr (assoc 0 pt1)))
  53.             (progn
  54.               (setq pt10 (cdr (assoc 10 pt1)))
  55.               (setq pt11 (cdr (assoc 11 pt1)))
  56.             )
  57.           )
  58.           (if (= "LWPOLYLINE" (cdr (assoc 0 pt1)))
  59.             (progn
  60.               (setq pt10 (entnext nam))
  61.               (setq pt11 (entnext pt10))
  62.               (setq pt10 (entget pt10))
  63.               (setq pt11 (entget pt11))
  64.               (setq pt10 (cdr (assoc 10 pt10)))
  65.               (setq pt11 (cdr (assoc 10 pt11)))
  66.             )
  67.           )
  68.           (setq ang1 (angle pt10 pt11))
  69.           ;;;;;以下求交点
  70.           (if (and
  71.                 (/= (abs (- ang ang1)) 0.0)
  72.                 (/= (abs (- ang ang1)) pi)
  73.               )
  74.             (progn
  75.               (setq pt10 (inters
  76.                            pt2
  77.                            pt4
  78.                            pt10
  79.                            pt11
  80.                            nil
  81.                          )
  82.               )
  83.               (setq e (append
  84.                         (list pt10)
  85.                         e
  86.                       )
  87.               )
  88.             )
  89.           )
  90.           ;;;;;; 交点结束
  91.         )
  92.       )
  93.       (setq n (+ n 1))
  94.     );;;;;;构建:垂直交点集 e结束
  95.     (setq p (- (length e) 1))
  96.     (setq n 0)
  97.     (setq f (ssadd))
  98.     (while (< n p)
  99.       (setq pt0 (nth n e))
  100.       (setq pt1 (nth (+ n 1) e))
  101.       (setq pt5 (polar pt0 (- ang1 (* 0.25 pi)) (* (getvar "DIMSCALE") 0.71)))
  102.       (setq pt6 (polar pt0 (+ ang1 (* 0.75 pi)) (* (getvar "DIMSCALE") 0.71)))
  103.       (command "_.PLINE" pt5 "W" (* (getvar "DIMSCALE") 0.45) "" pt6 "")
  104.       (ssadd (entlast) f)
  105.       (setq pt5 (polar pt0 ang1 (* (getvar "DIMSCALE") 10.0)))
  106.       (setq pt6 (polar pt0 (+ ang1 pi) (* (getvar "DIMSCALE") 4.0)))
  107.       (command "_.PLINE" pt5 "W" 0 "" pt6 "")
  108.       (ssadd (entlast) f)
  109.       (if (= n 0)
  110.         (setq pt00 pt0)
  111.       )
  112.       (if (= n (- p 1))
  113.         (progn
  114.           (setq pt1 (nth p e))
  115.           (setq pt5 (polar pt1 (- ang1 (* 0.25 pi)) (* (getvar "DIMSCALE") 0.71)))
  116.           (setq pt6 (polar pt1 (+ ang1 (* 0.75 pi)) (* (getvar "DIMSCALE") 0.71)))
  117.           (command "_.PLINE" pt5 "W" (* (getvar "DIMSCALE") 0.45) "" pt6 "")
  118.           (ssadd (entlast) f)
  119.           (setq pt5 (polar pt1 ang1 (* (getvar "DIMSCALE") 10.0)))
  120.           (setq pt6 (polar pt1 (+ ang1 pi) (* (getvar "DIMSCALE") 4.0)))
  121.           (command "_.PLINE" pt5 "W" 0 "" pt6 "")
  122.           (ssadd (entlast) f)
  123.           (setq ptp0 pt1)
  124.           (command "_.PLINE" pt00 "W" 0 "" ptp0 "")
  125.           (ssadd (entlast) f)
  126.         )
  127.       )
  128.       (setq dis (distance pt1 pt0))
  129.       (setq y1 (nth 1 pt0))
  130.       (setq y2 (nth 1 pt1))
  131.       (setq x1 (nth 0 pt0))
  132.       (setq x2 (nth 0 pt1))
  133.       (if (> y1 y2)
  134.         (progn
  135.           (setq ang (angle pt1 pt0))
  136.           (setq pt01 (polar pt1 ang (/ dis 2)))
  137.         )
  138.       )
  139.       (if (< y1 y2)
  140.         (progn
  141.           (setq ang (angle pt0 pt1))
  142.           (setq pt01 (polar pt0 ang (/ dis 2)))
  143.         )
  144.       )
  145.       (if (= y1 y2)
  146.         (progn
  147.           (if (> x1 x2)
  148.             (progn
  149.               (setq ang (angle pt1 pt0))
  150.               (setq pt01 (polar pt1 ang (/ dis 2)))
  151.             )
  152.           )
  153.           (if (< x1 x2)
  154.             (progn
  155.               (setq ang (angle pt0 pt1))
  156.               (setq pt01 (polar pt0 ang (/ dis 2)))
  157.             )
  158.           )
  159.         )
  160.       )
  161.       (setq pt01 (polar pt01 (+ ang (/ pi 2)) (getvar "DIMSCALE")))
  162.       (setvar "dimlfac" (/ 100 (getvar "dimscale")))
  163.       (setq dis (rtos (* (getvar "dimlfac") dis)))  
  164.       (setq p1 (strlen dis))
  165.       (setq pt4 (polar pt01 ang p1))
  166.       (setq pt3 (polar pt01 (+ ang pi) p1))
  167.       (setvar "TEXTSTYLE" "STANDARD")      
  168.       (command "TEXT" "J" "F" pt3 pt4 (* (getvar "DIMSCALE") 3.0) dis)
  169.       (ssadd (entlast) f)
  170.       (setq n (+ n 1))
  171.     )
  172.     (setvar "ORTHOMODE" 1)
  173.     (command "MOVE" f "" pt00 pause "")
  174.     (setvar "ORTHOMODE" 0)
  175.     (setvar "SNAPANG" 0)
  176.     (sset1)
  177.     (setq s (ssget))
  178.   )
  179. )
  180. ;;; ================================

回复 支持 反对

使用道具 举报

迷失1786
发表于 2018-5-24 23:49:32 | 显示全部楼层
收下了，谢谢
回复 支持 反对

使用道具 举报

stonedesign
发表于 2022-6-21 15:56:26 | 显示全部楼层
加载后没啥动静呀  闪一下就没了
回复 支持 反对

使用道具 举报

zhd81617
发表于 2022-6-21 19:41:14 | 显示全部楼层
NO FUNCTION DEFINITION:SSET
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-15 07:18 , Processed in 0.192927 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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