Jump to content

Convert lisp coordinates to vb.net language

quyenpv

By quyenpv
in .NET, ObjectARX & VBA

 Share

Recommended Posts

quyenpv Apprentice

quyenpv

Posted
Posted

I have collected a lisp that allows to pick coordinate points on Autocad drawings. Is there any way to convert the above lisp to vb.net language.

About the interface I designed the form as follows

image.png.c076ed8a739e6429a646dda333ce4d08.png

  

(defun C:TTD (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN
          B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK
          PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME
          EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH)
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(command "layer" "m" "QKHS" "c" "6" "" "")
(command "undo" "be")
 (setvar "cmdecho" 0)
 
 (command "undo" "begin")
 (vl-load-com)
;======================= Defun ==========================
 (defun rotate-text ( en ang / p1 p2 a e1)
   (setq p1 (acet-geom-textbox (setq e1 (entget en)) 0)
         p1 (acet-geom-midpoint (car p1) (caddr p1))
         e1 (subst (cons 11 p1) (assoc 11 e1) e1)
         a (cdr (assoc 50 e1))
         a (+ ang a)
         e1 (subst (cons 50 a) (assoc 50 e1) e1)
         e1 (subst (cons 72 1) (assoc 72 e1) e1)
         e1 (subst (cons 73 2) (assoc 73 e1) e1)
   );setq
(entmod e1)
(entupd EN))
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun angle-d2r (ANGD) (if ANGD (/ (* pi ANGD) 180) nil))
(defun angle-r2d (ANGR) (if ANGR (/ (* 180 ANGR) pi) nil))
(defun grnode (point radius color ang node fomp hightlight / ANGi PT0 PT1 PTg COL)
   (if fomp	
      (setq ANGi 0) 
      (setq ANGi (* 0.5 (angle-d2r ang))))
  (if (= color 0) (setq COL 10) (setq COL color))
  (setq PT0 (polar point ANGi radius) PTg PT0)
  (if node (grdraw point PT0 color hightlight))
  (while (<= ANGi (* 2 Pi))
     (setq ANGi (+ ANGi (angle-d2r ang))
             PT1 (polar point ANGi radius))
             (if (= color 0) (setq COL (1+ COL)))
             (if node (grdraw point PT0 COL hightlight) (grdraw PT0 PT1 COL hightlight))
     (setq PT0 PT1)
  );while
 (if (not node) (grdraw PT0 PTg COL hightlight))
);end grnode
(defun tencoc (EN) (if (check-nova EN) (cdr (nth 7 (car(cdr (assoc -3 (entget EN '("*"))))))) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun check-nova (EN) (if (= (car(car(cdr (assoc -3 (entget EN '("*")))))) "TDNW") T nil))
(defun lytrinh (EN) (if (check-nova EN) (rtos (cdr (nth 5 (car(cdr (assoc -3 (entget EN '("*"))))))) 2 2) (prompt "Doi tuong chon khong co du lieu tuyen")))
  
(defun accept ()
   (setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
   (get_tile "height") (get_tile "name") (get_tile "start") 0)) (done_dialog))
  
(defun nova ()
   (setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
   (get_tile "height") (get_tile "name") (get_tile "start") 1)) (done_dialog))
  
(defun node ()
   (if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "table" "1")))
  
(defun table ()
   (if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "node" "1")))
  
(defun style (/ htxt htxt0)
   (setq htxt0 (get_tile "height"))
   (if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth (fix (atof (get_tile "style"))) Lst-TS))))) 0)
   (progn (set_tile "height" (rtos htxt 2 3)) (mode_tile "height" 1))
   (progn (mode_tile "height" 0) (set_tile "height" htxt0))))
  
(defun baoloi (val key valkey)
  (if (= "." (substr val 1 1)) (setq val (strcat "0" val)))
  (if (not (or (= val "") (and (or (= (type (read val)) 'REAL) (= (type (read val)) 'INT)) (> (atof val) 0))))
    (progn
      (if (or (= key "height") (= key "start"))
       (repeat 2
        (set_tile "err" (strcat " "))
        (ACET-SYS-SLEEP 70)
        (set_tile "err" (strcat "Gia tri " valkey " phai la so thuc duong"))
        (ACET-SYS-SLEEP 120))
        (repeat 2
        (set_tile "err" (strcat " "))
        (ACET-SYS-SLEEP 70)
        (set_tile "err" (strcat "Gia tri " valkey " phai la so nguyen duong"))
        (ACET-SYS-SLEEP 120)))
        (mode_tile key 2)
        (mode_tile key 3)
        );progn
        (set_tile "err" (strcat "Statistical coordinates data record - \Toa do "))
     );if
  );end error
  
  (if (not TD-value) (setq TD-value (list "1" "1" (getvar "textstyle") "2.00" "N" "1" 0)))
  (setq DCL_CDn (list
        "Coordinate : dialog { value = \"http://taybac.1talk.net - \<Thong ke Toa do>\"; key = \"err\";" 
        "     : column { children_alignment = top;"
        "        : boxed_row { "
        "          : column {"
        "            : toggle { key = \"node\"; label = \"Chèn điểm\"; height = 1.4;}"
        "            : toggle { key = \"table\"; label = \"Chèn bảng\"; height = 2.5;}}"
        "          : column {"
        "           : popup_list { key = \"style\"; label = \"Text Style\"; edit_width = 10.1;}"
        "           : edit_box { key = \"height\"; label = \"Height Text\"; height = 1.1; edit_width = 11;}"
        "			      : tile	{ label = \"-\"; alignment = centered;}} "
        "          : column {"
        "           : edit_box { key = \"name\"; label = \"  Tên điể\"; height = 1.1; edit_width = 4;}" 
        "           : edit_box { key = \"start\"; label = \"  Số bắt đầu\"; height = 1.1; edit_width = 4;}"
        "			      : tile	{ label = \"-\"; alignment = centered;}} "
        "        } "
				"     : button { key = \"nova\"; label = \"Export Station coodinates from Road-Plan\";}"
        "        : row {"
        "             : button { key = \"cancel\"; label = \"   Thoat    \"; is_cancel = true;}"
        "             : button { key = \"accept\"; label = \"     Bat dau    \"; is_default = true;}}"
        "         }"
        "      }"    
        "helpTLuy : dialog { label = \"Help and Copyright\U+00A9 Information\";"
        "  : column {"
        "    : row { : list_box { key = \"helpList\"; edit_width = 95; width = 98; height = 25;}}"
        "    : row { : button { key = \"okayHelp\"; label = \"Okay\"; is_default = false; is_cancel = true;}}"
        "    }"
        "  }"
        )
     TEMP_CDn (vl-filename-mktemp "CDn.DCL")
     FILE_DCL (open TEMP_CDn "W"))
  
  (foreach LL DCL_CDn (write-line LL FILE_DCL))
  (close FILE_DCL)
  (setq DCL_ID (load_dialog TEMP_CDn))
  (new_dialog "Coordinate" DCL_ID)
  (set_tile "node" (nth 0 TD-value))
  (set_tile "table" (nth 1 TD-value))
  (set_tile "height" (nth 3 TD-value))
  (if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth 2 TD-value))))) 0)
  (progn (set_tile "height" (rtos htxt 2 2)) (mode_tile "height" 1)))
  (set_tile "name" (nth 4 TD-value))
  (set_tile "start" (nth 5 TD-value))
  (start_list "style")
  (setq Lst-TS (list (nth 2 TD-value) (cdr (assoc 2 (tblnext "Style" T)))))
  (while (setq TSN (tblnext "Style"))
  (if (and (/= (cdr (assoc 2 TSN)) (nth 2 TD-value)) (/= (cdr (assoc 2 TSN)) ""))
  (setq Lst-TS (append Lst-TS (list (cdr (assoc 2 TSN))))))
  );while
  (mapcar 'add_list Lst-TS)
  (end_list)
  (action_tile "cancel" "(exit)")
  (action_tile "accept" "(accept)")
  (action_tile "nova" "(nova)")
  (action_tile "node" "(node)")
  (action_tile "table" "(table)")
  (action_tile "style" "(style)")
  (action_tile "height" "(baoloi (get_tile \"height\") \"height\" \"''Cao chu''\")")
  (action_tile "start" "(baoloi (get_tile \"start\") \"start\" \"''STT''\")")
  (start_dialog) 
  (unload_dialog DCL_ID)
  (vl-file-delete TEMP_CDn)
  (setq H (atof (nth 3 TD-value)))
  (if (wcmatch (cdr (assoc 3 (tblsearch "style" (nth 2 TD-value)))) "*AVAN*,*ARIAL*,*BLACK*") (setq Wh (* 1.5 H)) (setq Wh 0))
  (if (= (nth 6 TD-value) 0) (progn
  (if (/= (nth 3 TD-value) "") (setq N (nth 3 TD-value)))
  (command "UCS" "W")
  (setvar "dimzin" 0)
	(command "undo" "begin")
  (if (= (nth 5 TD-value) "") (setq k 0) (setq k (- (atof (nth 5 TD-value)) 1)))
                               
  (if (= (nth 1 TD-value) "1") ; BEGIN TABLE
    (progn (prompt "Chọn điểm đặt bảng toạ độ.....")
    (while
      (if (= (car (setq GR (grread 't 15 0))) 5)
        (progn
          (if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
          (redraw)
          (setq BTR (cadr GR)
                BTL (polar BTR 0 (* H -26))
                BT1 (polar BTR 0 (* H -21))
                BT2 (polar BTR 0 (* H -10.5))
                BBR (polar BTR (* 0.5 pi) (* H -11))
                BBL (polar BTL (* 0.5 pi) (* H -11))
                BB1 (polar BT1 (* 0.5 pi) (* H -11))
                BB2 (polar BT2 (* 0.5 pi) (* H -11))
                BR (polar BTR (* 0.5 pi) (* H -2.4))
                BL (polar BTL (* 0.5 pi) (* H -2.4))
                OV (* H 0.3)
                VTR (polar BTR (* 0.25 pi) OV)
                VTL (polar BTL (* 0.75 pi) OV)
                VBR (polar BR (* 1.75 pi) OV)
                VBL (polar BL (* 1.25 pi) OV))
          (grdraw BTL BTR COL 1)
          (grdraw BTL BBL COL 1)
          (grdraw BTR BBR COL 1)
          (grdraw BT1 BB1 COL 1)
          (grdraw BT2 BB2 COL 1)
          (grdraw BR BL COL 1)
          (repeat 3
          (setq BR (polar BR (* 0.5 pi) (* H -2.0))
                BL (polar BL (* 0.5 pi) (* H -2.0))
                BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
                BB2 (polar BT2 (* 0.5 pi) (* H -2.4)))
          (grdraw BR BL COL 1)) T)
       (progn
          (setq PTitle (list (- (car BTR) (* 13 H)) (+ (cadr BTR) (* 1.8 H)))
                BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
                BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
                BTT (list (- (car BTR) (* 23.5 H)) (+ (cadr BTR) (* -1.2 H)))
                BR (polar BTR (* 0.5 pi) (* H -2.4))
                BL (polar BTL (* 0.5 pi) (* H -2.4)))
     (setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
                   (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL))))  
     (setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
                   (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL))))
     (setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
                   (cons 10 BB1) (cons 10 BT1))))
     (setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
                   (cons 10 BB2) (cons 10 BT2))))
     (entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H))
                   (cons 1 "BẢNG TOẠ ĐỘ ĐIỂM") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
     (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
                   (cons 1 "Điểm") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
     (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
                   (cons 1 "X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))		 
     (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
                   (cons 1 "Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
     (setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
           BTY (polar BTY (* -0.5 pi) (* 2.2 H))
           BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
 (prompt " OK Man!"))))));if END TABLE
                               
 (while
   (progn
     (initget 128 "u")
     (setq TD0 (getpoint (strcat "\n Pick điểm thứ: "(rtos (setq k (1+ k)) 2 0) " : ")))
     (if (= TD0 "u") (vl-cmdf "undo" "Back") TD0))
 (if (/= TD0 "u") (progn
 (vl-cmdf "undo" "mark")
 (princ TD0)
 (setq X (rtos (car TD0) 2 3) Y (rtos (cadr TD0) 2 3))
 (if (= (nth 1 TD-value) "1")
  (progn ;put into table
	 (setq STTBTD (strcat (nth 4 TD-value) (rtos k 2 0)))
	 (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
	 (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
	 (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
	 (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))		 
	 (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
	 (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
	 (setq BTX (polar BTX (* -0.5 pi) (* 2 H))
         BTY (polar BTY (* -0.5 pi) (* 2 H))
         BTT (polar BTT (* -0.5 pi) (* 2 H)))
	 (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
	 (setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
	 (entmod EB1) (entupd B1)
	 (setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
	 (entmod EB2) (entupd B2)
	 (setq EBK (entget BK)
         BRi (polar BR (* -0.5 pi) (* 2 H))
         BLi (polar BL (* -0.5 pi) (* 2 H))
         EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
         EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
         BR Bri BL BLi)
	 (entmod EBK) (entupd BK)
 	 (setq EVK (entget VK)
         VRi (polar VBR (* -0.5 pi) (* 2 H))
         VLi (polar VBL (* -0.5 pi) (* 2 H))
         EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
         EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
         VBR Vri VBL VLi)
	 (entmod EVK) (entupd VK)
	 );progn
 );if END put into table
                    
 (if (= (nth 0 TD-value) "1")
	(progn
	 (setq SSnode (ssadd))
	 (setq PTX (polar TD0 0 (* H 0.7))
         PTY (polar PTX (* pi -0.5) (* H 1.35)))
   (entmake (list '(0 . "TEXT") (cons 10 PTX) (cons 11 PTX) (cons 40 H) (cons 1 (strcat "X:"X)) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 1)))
	 (setq TB  (textbox (entget(entlast)))
         DIX (distance (car TB) (cadr TB))
         PTL (polar PTX 0 (+ DIX (* 0.12 H))))
	 (setq SSnode (ssadd (entlast) SSnode))
	 (entmake (list '(0 . "TEXT") (cons 10 PTY) (cons 40 H) (cons 1 (strcat "Y:"Y)) (cons 7 (nth 2 TD-value)) '(72 . 0)))
	 (setq TB  (textbox (entget(entlast))))
	 (if (< DIX (setq DIY (distance (car TB) (cadr TB))))
   (setq PTL (polar PTX 0 (+ DIY (* 0.12 H)))))
  (setq SSnode (ssadd (entlast) SSnode))
  (setq EPL (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
                            '(90 . 3) (cons 10 TD0) (cons 10 (polar TD0 0 (* 0.000000001 H))) (cons 10 PTL))))
  (setq SSnode (ssadd EPL SSnode))
  (if (/= (strcat (nth 4 TD-value) (nth 5 TD-value)) "")
 (progn
  (setq PTE (polar PTL 0 (+ (* 0.11 Wh) (* 1.5 H))))
  (setq name (strcat (nth 4 TD-value) (rtos k 2 0)))
  (entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
  (cons 10 PTE) (cons 11 (list (+ (* 0.11 Wh) (* 1.5 H)) 0 0)) (cons 40 (- 0.75 (if (= 0 Wh) 0 0.06)))))
  (setq SSnode (ssadd (entlast) SSnode))
  (entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
                 '(62 . 8) (cons 10 PTE) (cons 11 (list (+ (* 0.1 Wh) (* 1.4 H)) 0 0)) (cons 40 (- 0.74 (if (= 0 Wh) 0 0.06)))))
  (setq SSnode (ssadd (entlast) SSnode))
  (entmake (list '(0 . "TEXT") (cons 10 PTE) (cons 11 PTE) (cons 40 H)
  (cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
  (setq SSnode (ssadd (entlast) SSnode))))
  (ACET-SS-REDRAW SSnode 2)
  (if (not (setq PT1 (ACET-SS-DRAG-MOVE SSnode TD0 "" nil 0)))
     (Setq PT1 TD0)
     (setq del (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 PT1)))))
  (vl-cmdf "move" SSnode "" TD0 PT1)
  (ACET-SS-REDRAW SSnode 2)
  (if (not (setq ANG (ACET-SS-DRAG-ROTATE SSnode PT1 "" nil 0)))
  (if (< (* 0.5 pi) (angle PT1 (cadr (grread 't 15 0))) (* 1.5 pi)) (setq ANG pi)	(setq ANG 0)))
  (vl-cmdf "erase" del "")
  (vl-cmdf "rotate" SSnode "" PT1 (rtos (angle-r2d ANG) 2 2))
  (setq SSnode (acet-ss-to-list SSnode))
  (if (< (* 0.5 pi) ANG (* 1.5 pi))
    (foreach SSn SSnode (if (= (DXF 0 SSn) "TEXT") (rotate-text SSn pi))))
    (setq EgPL (entget EPL) EgPL (subst (cons 10 TD0) (assoc 10 EgPL) EgPL))
    (entmod EgPL)   (entupd EPL)
 );progn
 (progn
  (if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
  (progn (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.09) COL 90 T nil 0)
  (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.2) COL 45 T nil 0)))
 ))
 (progn
  (setq k (- k 2)
        BTX (polar BTX (* 0.5 pi) (* 2 H))
        BTY (polar BTY (* 0.5 pi) (* 2 H))
        BTT (polar BTT (* 0.5 pi) (* 2 H))
        BB1 (polar BB1 (* 0.5 pi) (* 2 H))
        BB2 (polar BB2 (* 0.5 pi) (* 2 H))
        BR  (polar BR  (* 0.5 pi) (* 2 H))
        BL  (polar BL  (* 0.5 pi) (* 2 H))
        VBR (polar VBR (* 0.5 pi) (* 2 H))
        VBL (polar VBL (* 0.5 pi) (* 2 H))))
 );if
 );while
                               
 (prompt "Done\n \• Bản ghi dữ liệu tọa độ thống kê - Copyright© 2023")
 (setq TD-value (ACET-LIST-PUT-NTH (rtos k 2 0) TD-value 5)))
;=== Xuat bang toa do coc tu binh do tuyen
 (progn
 (if (setq SSC (acet-ss-to-list (ssget '((0 . "LINE") (8 . "ENTCOC")))))
 (progn
   (setq BTR (cadr (grread 't 15 0))
         BTL (polar BTR 0 (- (* H -26) Wh))
         BT1 (polar BTR 0 (* H -21))
         BT2 (polar BTR 0 (* H -10.5))
         BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
         BB2 (polar BT2 (* 0.5 pi) (* H -2.4))
         BR (polar BTR (* 0.5 pi) (* H -2.4))
         BL (polar BTL (* 0.5 pi) (* H -2.4))
         PTitle (list (- (car BTR) (+ (* 0.5 Wh) (* 13 H))) (+ (cadr BTR) (* 1.8 H)))
         BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
         BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
         BTT (list (- (car BTR) (+ (* 0.5 Wh) (* 23.5 H))) (+ (cadr BTR) (* -1.2 H)))
         OV (* H 0.3)
         VTR (polar BTR (* 0.25 pi) OV)
         VTL (polar BTL (* 0.75 pi) OV)
         VBR (polar BR (* 1.75 pi) OV)
         VBL (polar BL (* 1.25 pi) OV))
    (setq SSnode (ssadd))
    (setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL)))
          SSnode (ssadd (entlast) SSnode))
    (setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL)))
          SSnode (ssadd (entlast) SSnode))
    (setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1)))
          SSnode (ssadd (entlast) SSnode))
    (setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2)))
          SSnode (ssadd (entlast) SSnode))
    (entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%%UB¶ng Täa ®é cäc") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "Tªn cäc") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "Täa §é X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))		 
    (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "Täa §é Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
          BTY (polar BTY (* -0.5 pi) (* 2.2 H))
          BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
    (prompt "OK Man! ")
    (setq SSC (vl-sort SSC '(lambda (EN1 EN2) (< (atof (lytrinh EN1)) (atof (lytrinh EN2))))))
    (foreach SSn SSC
    (setq TD0 (acet-geom-midpoint (DXF 10 SSn) (DXF 11 SSn))
          X (rtos (car TD0) 2 3)
          Y (rtos (cadr TD0) 2 3)					 
          STTBTD (tencoc SSn))
    (entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))	(cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))	(cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))	(cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
    (setq SSnode (ssadd (entlast) SSnode))
    (setq BTX (polar BTX (* -0.5 pi) (* 2 H))
          BTY (polar BTY (* -0.5 pi) (* 2 H))
          BTT (polar BTT (* -0.5 pi) (* 2 H)))
    (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
    (setq SSnode (ssadd (entlast) SSnode))
    (setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
    (entmod EB1) (entupd B1)
    (setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
    (entmod EB2) (entupd B2)
    (setq EBK (entget BK)
           BRi (polar BR (* -0.5 pi) (* 2 H))
           BLi (polar BL (* -0.5 pi) (* 2 H))
           EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
           EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
           BR Bri BL BLi)
    (entmod EBK) (entupd BK)
    (setq EVK (entget VK)
           VRi (polar VBR (* -0.5 pi) (* 2 H))
           VLi (polar VBL (* -0.5 pi) (* 2 H))
           EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
           EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
           VBR Vri VBL VLi)
     (entmod EVK) (entupd VK))
     (acet-ss-redraw SSnode 2)
     (setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
     (if (setq PT1 (acet-ss-drag-move SSnode BTR "Chọn điểm đặt bảng toạ độ..."))
     (vl-cmdf "move" SSnode "" BTR PT1)
     (vl-cmdf "erase" SSnode ""))
     (setvar "orthomode" OTHLAST)
 );progn
 ));if End Xuat bang toa do coc tu binh do
);if
(command "UCS" "P")
(command "undo" "end")
(princ)
);end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Text.lsp

BIGAL Grand Master

BIGAL

Posted
Posted

There was years ago LISP2C program, it converted lsp to C code. I have a copy but the problem is that as its old you need to run on a 16bit pc and there was a registration fee  or free if short code. Program was written 1994.

 

Anything is possible as per the old program,  just need smarter people than me. 

 

Sample output.

 

DRIVEWAY.zip

BIGAL Grand Master

BIGAL

Posted
Posted

The program converts lsp to C code. Just need a 16bit emulator to run the old code.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...