barros 发表于 2022-7-5 18:21:42

(帮助)使用引线绘制多段线

你好。
请帮帮我。我是AUTOLISP的新手。
我对现有道路的地形有问题。我想用引线点编号STA和x,y坐标(excel文件)绘制现有道路的中心线多段线,并从值z绘制现有L截面。
 
请帮帮我。
非常感谢
 
规划目标计划。图纸
数据XYZ数据。xls公司

barros 发表于 2022-7-5 19:29:12

我得到了这个代码,请更正,如何编辑字符串来绘制z值。
 
 
(defun c:poligon ()

;====== Input Data ! ====================
; ! STA !       X (m)   !       Y (m)   !
; !(10)    !       (15)      !       (15)      !
;=================================================
; disimpan di C:\procad\data\*.prn


; ++++ INPUT FROM KEY BOARD ++++
(setq fnam1 "C:/Procad/Data/")
(setq fnam2 "*.prn")
(setq fnam3 "/procad/DFILE/CROSS/")

(setq lastLL 2
   lastRR 5
)
(setq f    (getstring
   (strcat "\nFile Input Polygon Data c:/procad/data/ < " fnam2 " > ? : ")
   )
)
(if (/= f "")
(setq fnam2 f)
)
(setq fnam (strcat fnam1 fnam2))
(setq check (findfile fnam))
(while (= check nil)
(prompt "\nNo File Found .....! ")
(setq    f (getstring
       (strcat "\nFile Input Polygon Data c:/procad/data/ < " fnam2 " > ? : ")
   )
)
(if (/= f "")
   (setq fnam2 f)
)
(setq fnam (strcat fnam1 fnam2))
(setq check (findfile fnam))
)                  ; while

; ====== OUTPUT DATA sudut poligon
(setq filout0 (getstring "\nFile Output Polygon Angle < *.txt > ? : "))
(setq filout (strcat "c:/procad/data/" filout0))
(setq foo (open filout "w"))

; ====== BACA DATA
(setq fp (open fnam "r"))
(setq file (read-line fp))
(if (= file "") (setq file nil))
(if (= file nil) (setq stop 1) (setq stop 0))
(setq file (read-line fp))

(setq patok0 (substr file 1 7))      ; STA
(setq PX0 (atof (substr file 11 15)))    ; koordinat x1
(setq PY0 (atof (substr file 26 15)))    ; koordinat y1
(setq p0 (list PX0 PY0))

(setq file (read-line fp))
(setq patok1 (substr file 1 7))      ; STA
(setq PX1 (atof (substr file 11 15)))    ; koordinat x1
(setq PY1 (atof (substr file 26 15)))    ; koordinat y1
(setq p1 (list PX1 PY1))
(command "color" 20 "-linetype" "s" "dashdot" "")
(command "pline" p0 p1 "")

;==== plot garis poligon
(while (= stop 0)
(setq file (read-line fp))
(setq patok2 (substr file 1 7))      ; STA
(setq PX2 (atof (substr file 11 15)))    ; koordinat x1
(setq PY2 (atof (substr file 26 15)))    ; koordinat y1
(setq p2 (list PX2 PY2))
(command "color" 20)
(command "line" p1 p2 "")
(command "color" 2)
(command "point" p1)
(command "color" 7)
(command "text" p1 "3" "45" patok1 "")
(setq sdtp1p0 (angle p1 p0))      ;sudut p1-p0 (radian)
(setq sdtp1p2 (angle p1 p2))      ;sudut p1-p0 (radian)
(setq sdt20 (- sdtp1p0 sdtp1p2))
(setq sdt20a (/ (* sdt20 180.0) pi))    ;sudut1 dalam derajad
(setq sdt20aa (* (- 360.000 sdt20a) 0.50))      ;sudut1 dalam derajad

;===== tulis data sudut di file output
(setq data (strcat patok1 "   " (rtos sdt20aa 2 3)))
(write-line data foo)

(setq p0 p1)
(setq p1 p2)
(setq patok1 patok2)
(if (= file "")
   (setq file nil)
)
(if (= file nil)
   (setq stop 1)
   (setq stop 0)
)
)                  ;while

(close fp)
(close foo)
);defun


页: [1]
查看完整版本: (帮助)使用引线绘制多段线