求修改，此程序只能绘制Y轴视图，如何增加可绘制X轴视图的功能。

lohas1118

file:///C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/ksohtml/wps_clip_image-19483.png

此程序只能绘制Y轴视图，如何增加可绘制X轴视图的功能。
不知为何原因无法上传图片，通俗点说就是只能画竖的方向视图，但有时我需要画横的方向视图。求高手帮忙修改，多谢了。
补充：绘制的视图是聚合的，要修改成不是聚合线的图。

;;;;;;冲子侧视图绘制程序
(defun c:cfs()
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq OSM (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (= run nil)
(progn
(setq qza 50)
(setq oqza qza)
(setq vd 20)
(setq oVd Vd)
(setq run 1)
)
)
(setq msg "请输入高度值:")
  (if (/= qza nil) (setq msg (strcat "\n请输入高度值<" (rtos qza) ">:")))
  (initget 6)
  (setq qza (getreal msg))
  (if (= qza nil) (setq qza oqza))
  (setq oqza qza)
(setq msg "\n请输入视图间距:")
  (if (/= Vd nil) (setq msg (strcat "\n请输入视图间距<" (rtos Vd) ">:")))
  (initget 6)
  (setq Vd (getreal msg))
  (if (= Vd nil) (setq Vd oVd))
  (setq oVd Vd)
(initget 1)
(setq poi (getpoint "\n请在原图内选取一点"))
(COMMAND "BOUNDARY" poi "")
(setq txtnn (ssget "L"))
(setq txtn (ssname txtnn 0))
(setq tdate (entget txtn))
(command "undo" "1")
(setq x (list (cadr (assoc '10 tdate))))
(setq y (list (caddr (assoc '10 tdate))))
(foreach n tdate
  (if (= 10 (car n))
   (progn
    (setq x1 (list (cadr n)))
    (setq x (append x x1))
    (setq y1 (list (caddr n)))
    (setq y (append y y1))
   )
  )
)
(setq x1  (car (vl-sort x '>)))
(setq x2  (car (vl-sort x '<)))
(setq y1  (car (vl-sort y '>)))
(setq y2  (car (vl-sort y '<)))
(setq dx (- x1 x2))
(setq dy (- y1 y2))
(setq ck (getpoint "\n请在有缺口一侧点击"))
(if (< (car ck) (* 0.5 (+ x1 x2)))
(progn
(setq pf  (list x2 (- y2 Vd)))
(setq pf1 (mapcar '+ pf (list dx 0)))
(setq pf2 (mapcar '- pf1 (list 0 qza)))
(setq pf3 (mapcar '- pf2 (list dx 0)))
(setq pf7 (mapcar '- pf (list 0 15.95)))
(setq pf6 (mapcar '+ pf7 (list 1 0)))
(setq pf5 (mapcar '- pf6 (list 0 3.5)))
(setq pf4 (mapcar '- pf5 (list 1 0)))
(command "ucs" "w")
(command "pline" pf pf1 pf2 pf3 pf4 pf5 pf6 pf7 "c")
)
(progn
(setq pf (list x2 (- y2 Vd)))
(setq pf1 (mapcar '- pf (list 0 qza)))
(setq pf2 (mapcar '+ pf1 (list dx 0)))
(setq pf7 (mapcar '+ pf  (list dx 0)))
(setq pf6 (mapcar '- pf7 (list 0 17.95)))
(setq pf5 (mapcar '- pf6 (list 1 0)))
(setq pf4 (mapcar '- pf5 (list 0 3.5)))
(setq pf3 (mapcar '+ pf4 (list 1 0)))
(command "ucs" "w")
(command "pline" pf pf1 pf2 pf3 pf4 pf5 pf6 pf7 "c")
)
)
(setvar "OSMODE" OSM)
(setvar "cmdecho" oce)
)

vectra

lohas1118 发表于 2013-7-17 11:07
你好多谢您的帮助，但试了不行。
提示错误: 输入的列表有缺陷

好吧。。。

lohas1118

补充：绘制的视图是聚合的，要修改成不是聚合线的图。谢谢

lohas1118

lohas1118

lohas1118

lohas1118

十天了都

流星蔡园

lohas1118

vectra

用下面的代码替换原程序相应位置的代码，X方向的视图画在原图右边

1. (if (> (cadr ck) (* 0.5 (+ y1 y2)))
   
2.     (progn
   
3.       (setq pf (list (+ x1 vd) y1))
   
4.       (setq pf1 (mapcar '- pf (list 0 dy)))
   
5.       (setq pf2 (mapcar '+ pf1 (list qza 0)))
   
6.       (setq pf3 (mapcar '+ pf2 (list 0 dy)))
   
7.       (setq pf7 (mapcar '+ pf (list 15.95 0)))
   
8.       (setq pf6 (mapcar '- pf7 (list 0 1)))
   
9.       (setq pf5 (mapcar '+ pf6 (list 3.5 0)))
   
10.       (setq pf4 (mapcar '+ pf5 (list 0 1)))
    
11.       (command "ucs" "w")
    
12.       (command "pline" pf pf1 pf2 pf3 pf4 pf5 pf6 pf7 "c")
    
13.     )
    
14.     (progn
    
15.       (setq pf (list (+ x1 vd) y1))
    
16.       (setq pf1 (mapcar '- pf (list 0 dy)))
    
17.       (setq pf2 (mapcar '+ pf1 (list qza 0)))
    
18.       (setq pf3 (mapcar '+ pf2 (list 0 dy)))
    
19.       (setq pf7 (mapcar '+ pf1 (list 15.95 0)))
    
20.       (setq pf6 (mapcar '+ pf7 (list 0 1)))
    
21.       (setq pf5 (mapcar '+ pf6 (list 3.5 0)))
    
22.       (setq pf4 (mapcar '- pf5 (list 0 1)))
    
23.       (command "ucs" "w")
    
24.       (command "pline" pf pf1 pf7 pf6 pf5 pf4 pf2 pf3 "c")
    
25.     )
    
26.   )

(if (> (cadr ck) (* 0.5 (+ y1 y2)))<br />     (progn<br />       (setq pf (list (+ x1 vd) y1))<br />       (setq pf1 (mapcar '- pf (list 0 dy)))<br />       (setq pf2 (mapcar '+ pf1 (list qza 0)))<br />       (setq pf3 (mapcar '+ pf2 (list 0 dy)))<br />       (setq pf7 (mapcar '+ pf (list 15.95 0)))<br />       (setq pf6 (mapcar '- pf7 (list 0 1)))<br />       (setq pf5 (mapcar '+ pf6 (list 3.5 0)))<br />       (setq pf4 (mapcar '+ pf5 (list 0 1)))<br />       (command "ucs" "w")<br />       (command "pline" pf pf1 pf2 pf3 pf4 pf5 pf6 pf7 "c")<br />     )<br />     (progn<br />       (setq pf (list (+ x1 vd) y1))<br />       (setq pf1 (mapcar '- pf (list 0 dy)))<br />       (setq pf2 (mapcar '+ pf1 (list qza 0)))<br />       (setq pf3 (mapcar '+ pf2 (list 0 dy)))<br />       (setq pf7 (mapcar '+ pf1 (list 15.95 0)))<br />       (setq pf6 (mapcar '+ pf7 (list 0 1)))<br />       (setq pf5 (mapcar '+ pf6 (list 3.5 0)))<br />       (setq pf4 (mapcar '- pf5 (list 0 1)))<br />       (command "ucs" "w")<br />       (command "pline" pf pf1 pf7 pf6 pf5 pf4 pf2 pf3 "c")<br />     )<br />   )