一个软件里的程序 没有自定义函数 有高手能完善么！

xiguanyiren_y

这个是一个软件里的程序，只知道下面的代码，有的自定义函数没有！
软件太多，只想用这个来画人行道线！
能否改成通用？

(defun ppsgetcfg(strvar / retv)
  (setq retv (getcfg (strcat "AppDATA/Hongye/PPS/" (strcase strvar))))
  (if (null retv) (setq retv ""))
  retv
)

;;;global variable   angle11  dist11 dist22 jlength1 angle3
(defun c:rxhd (/              p1       p2        p3         p4          angle1
             angle2   angle4   angle22        angle21         el          ell
             n              dist1    dist2        pfirst         psencond jlength
             jlength2 jxlength str        plwid          drawbx
             uctr     loop     olddrawbx         ptem
            )
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setq plwid (/ (DL_GetLayerLineWidth "PP-DL-RXHD") (DL_GetDrawingFactor)))
  (DL_MakeLayer "PP-DL-RXHD")
  (setq        drawbx          (ppsgetcfg "hysz_rxhd_drawbx")
        olddrawbx drawbx
  )
  (if (or (= drawbx "") (= drawbx nil))
    (setq drawbx "N")
  )
  (initget "Y N")
  (if (= drawbx "N")
    (progn
      (setq p1 (getkword "\n选择: 绘制两侧边线Y /<不绘两侧边线>:"))
      (if (= p1 "Y")
        (setq drawbx "Y")
      )
    )
    (progn
      (setq p1 (getkword "\n选择: 不绘两侧边线N /<绘制两侧边线>:"))
      (if (= p1 "N")
        (setq drawbx "N")
      )
    )
  )
  (setq        loop t)
        uctr (HY_ClearUNDO)
  )
  (while loop
    (setq angle4 nil
          jlength2 nil
    )
    (initget "U")
    (setq p1 (getpoint "\n回车退出 /回退U /输入人行横道线起点:"))
    (cond
      ((null p1) (setq loop nil))
      ((= p1 "U")
       ($undob uctr)
      )
      (t
       (initget 1)
       (setq p2 (getpoint p1 "\n输入人行横道线终点:"))
       (if (< (pmdist p1 p2) 1.0)
         (prompt "\n起点与终点距离太短!")
         (progn
           (initget (+ 2 4))
           (if (null dist11)
             (setq dist11 5.0)
           )
           (setq dist1
                  (getdist p1
                           (strcat "\n输入横道线宽度<" (rtos dist11 2 2) ">:")
                  )
           )
           (if (= dist1 nil)
             (setq dist1 dist11)
             (setq dist11 dist1)
           )
           (setq angle2 (angle p1 p2))
           (initget "X")
           (setq
             ptem (getpoint
                    p1
                    "\n回车与长度方向垂直 /选择平行线X /输入宽度方向:"
                  )
           )
           (cond
             ((= ptem nil)
              (setq angle1 (+ angle2 (* pi 0.5)))
             )
             ((= ptem "X")
              (setq angle1 (&tpxx_ang "\n选择平行线:"))
             )
             (t
              (setq angle1 (angle p1 ptem))
             )
           )
           (setq dist2 (pmdist p1 p2))
           (if (null jlength1)
             (setq jlength1 0.5)
           )
           (setq xh t)
           (while xh
             (initget (+ 2 4))
             (setq jlength (getreal (strcat "\n输入横道线间距<"
                                            (rtos jlength1 2 2)
                                            ">:"
                                    )
                           )
             )
             (if (> jlength dist2)
               (prompt "\n线间距须大于起点与终点长度,重输.")
               (progn
                 (if (null jlength)
                   (setq jlength jlength1)
                   (setq jlength1 jlength)
                 )
                 (setq jlength2        jlength
                       xh        nil
                 )
               )                        ;end of progn
             )                                ; end of if
           )                                ;end of while xh
           (setq pa (polar p1 angle1 (* dist1 0.5))
                 pb (polar p1 angle1 (* dist1 -0.5))
           )
           (setq p1 pa
                 p2 pb
                 p3 (polar p1 angle2 dist2)
                 p4 (polar p2 angle2 dist2)
           )
           (HY_UndoM)
           (HY_SV)
           (if (= drawbx "Y")
             (command "line" p1 p3 p4 p2 "c")
             (progn
               (command "line" p1 p2 "")
               (command "line" p3 p4 "")
             )
           )
           (setq angle21 (- angle2 angle1))
           (setq jxlength (/ jlength (abs (sin angle21))))
           (setq pfirst (polar p1 angle2 jxlength))
           (setq psencond (polar p2 angle2 jxlength))
           (command "pline" p1 "w" plwid "" p2 "")
           (setq el (entlast))
           (command "change" el "" "p" "c" 5 "")
           (command "pline" p3 "w" plwid "" p4 "")
           (setq ell (entlast))
           (setq n 0)
           (while (>= (pmdist p1 p3) (pmdist p1 pfirst))
             (setq n (+ n 1))
             (if (zerop (rem n 5))
               (progn
                 (command "pline" pfirst "w" plwid "" psencond "")
                 (setq el (entlast))
                 (command "change" el "" "p" "c" 5 "")
               )
               (command "pline" pfirst "w" plwid "" psencond "")
             )                                ;end of if
             (setq pfirst (polar pfirst angle2 jxlength))
             (setq psencond (polar psencond angle2 jxlength))
           )                                ;end of while
           (HY_RV)
         )
       )                                ;end of if pmdist p1 p2
      )
    )                                        ;end of cond
  )                                        ;end of while loop
  (if (/= drawbx olddrawbx)
    (setq drawbx (ppssetcfg "hysz_rxhd_drawbx" drawbx))
  )
  (setvar "BLIPMODE" 1)
  (setvar "CMDECHO" 1)
  (princ)
)                                        ;end

xiguanyiren_y

定一下！！！！

spshchen

你把VLX文件 或者 FAS文件发给我，我有时间看下。 050868@163.com

菡萏

看演示这个功能很简单嘛!分析别人的代码你还不如重写一个呢!

xiguanyiren_y

spshchen 发表于 2014-12-1 12:18
你把VLX文件 或者 FAS文件发给我，我有时间看下。

如果有VLX和FAS 我就直接用了
是一个很大的专业软件！

xiguanyiren_y

菡萏 发表于 2014-12-1 14:50
看演示这个功能很简单嘛!分析别人的代码你还不如重写一个呢!

如果能重写也可以的！
可惜我是业余的！

菡萏

xiguanyiren_y 发表于 2014-12-1 15:25
如果能重写也可以的！
可惜我是业余的！

在这论坛里混的，基本上没有一个是专业的！都是业余的！

xiguanyiren_y

菡萏 发表于 2014-12-1 19:31
在这论坛里混的，基本上没有一个是专业的！都是业余的！

你说简单，能否帮忙写一下呢！

菡萏

xiguanyiren_y 发表于 2014-12-2 08:40
你说简单，能否帮忙写一下呢！

代码仅是个绘制示例,请自行根据需要完善!

1. (defun c:tt (/            PERDIST          OS         CMDECHO       P1     P2             P3            W           W1          D         LEN        N      ANG    ANG1
   
2.              PT1    PT2           *error*
   
3.             )
   
4.   (defun *error* (s)
   
5.     (setvar 'osmode os)
   
6.     (setvar 'cmdecho cmdecho)
   
7.     (princ s)
   
8.   )
   
9. 
   
10.   (defun PerDist (pt p1 p2 / norm)
    
11.     (setq norm (mapcar '- p2 p1)
    
12.           p1   (trans p1 0 norm)
    
13.           pt   (trans pt 0 norm)
    
14.     )
    
15.     (- (car pt) (car p1))
    
16.   )
    
17.   (setq os (getvar 'osmode))
    
18.   (setvar 'osmode 681)
    
19.   (setq cmdecho (getvar 'cmdecho))
    
20.   (setvar 'cmdecho 0)
    
21.   (if (and
    
22.         (setq p1 (getpoint  "\n起点:"))
    
23.         (setq p2 (getpoint p1 "\n中点:"))
    
24.         (setq p3 (getpoint p2 "\n终点:"))
    
25.       )
    
26.     (progn
    
27.       (initget 6)
    
28.       (setq w (getreal "\n半宽<0.5>:"))
    
29.       (if (null w)
    
30.         (setq w 0.5)
    
31.       )
    
32.       (setq w1 (getreal "\n间距<1.0>:"))
    
33.       (if (null w1)
    
34.         (setq w1 1.0)
    
35.       )
    
36.       (setq d (abs (perdist p1 p2 p3)))
    
37.       (setq len (distance p2 p3))
    
38.       (setq w1 (- (/ len (setq n (fix (/ len (+ w1 w w))))) w w))
    
39.       (setq ang         (angle p2 p3)
    
40.             ang1 (+ ang (* pi 0.5))
    
41.       )
    
42.       (setq pt1        (polar p2 ang1 (- d))
    
43.             pt2        (polar pt1 ang1 (* 2 d))
    
44.       )
    
45.       (command "pline" "non" pt1 "H" w w "non" pt2 "")
    
46.       (setq p1 pt1 p2 pt2)
    
47.       (repeat n
    
48.         (setq pt1 (polar pt1 ang (+ w w w1))
    
49.               pt2 (polar pt1 ang1 (* 2 d))
    
50.         )
    
51.         (command "pline" "non" pt1 "non" pt2 "")
    
52.       )
    
53.       (command "line" "non" p1 "non" pt1 "")
    
54.       (command "line" "non" p2 "non" pt2 "")
    
55.     )
    
56.   )
    
57.   (setvar 'osmode os)
    
58.   (setvar 'cmdecho cmdecho)
    
59.   (princ)
    
60. )

(defun c:tt (/            PERDIST          OS         CMDECHO       P1     P2             P3            W           W1          D         LEN        N      ANG    ANG1<br />              PT1    PT2           *error*<br />             )<br />   (defun *error* (s)<br />     (setvar 'osmode os)<br />     (setvar 'cmdecho cmdecho)<br />     (princ s)<br />   )<br /> <br />   (defun PerDist (pt p1 p2 / norm)<br />     (setq norm (mapcar '- p2 p1)<br />           p1   (trans p1 0 norm)<br />           pt   (trans pt 0 norm)<br />     )<br />     (- (car pt) (car p1))<br />   )<br />   (setq os (getvar 'osmode))<br />   (setvar 'osmode 681)<br />   (setq cmdecho (getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (if (and<br />         (setq p1 (getpoint  "\n起点:"))<br />         (setq p2 (getpoint p1 "\n中点:"))<br />         (setq p3 (getpoint p2 "\n终点:"))<br />       )<br />     (progn<br />       (initget 6)<br />       (setq w (getreal "\n半宽<0.5>:"))<br />       (if (null w)<br />         (setq w 0.5)<br />       )<br />       (setq w1 (getreal "\n间距<1.0>:"))<br />       (if (null w1)<br />         (setq w1 1.0)<br />       )<br />       (setq d (abs (perdist p1 p2 p3)))<br />       (setq len (distance p2 p3))<br />       (setq w1 (- (/ len (setq n (fix (/ len (+ w1 w w))))) w w))<br />       (setq ang         (angle p2 p3)<br />             ang1 (+ ang (* pi 0.5))<br />       )<br />       (setq pt1        (polar p2 ang1 (- d))<br />             pt2        (polar pt1 ang1 (* 2 d))<br />       )<br />       (command "pline" "non" pt1 "H" w w "non" pt2 "")<br />       (setq p1 pt1 p2 pt2)<br />       (repeat n<br />         (setq pt1 (polar pt1 ang (+ w w w1))<br />               pt2 (polar pt1 ang1 (* 2 d))<br />         )<br />         (command "pline" "non" pt1 "non" pt2 "")<br />       )<br />       (command "line" "non" p1 "non" pt1 "")<br />       (command "line" "non" p2 "non" pt2 "")<br />     )<br />   )<br />   (setvar 'osmode os)<br />   (setvar 'cmdecho cmdecho)<br />   (princ)<br /> )

xiguanyiren_y

菡萏 发表于 2014-12-2 09:34
代码仅是个绘制示例,请自行根据需要完善!

厉害！我看看！ 能否 不用点起点和中点  这2点的距离是固定的2.5