Thursday, 4 July 2013

Import and export object info from text file -command called PLACE and Placetext

;;The lisp file link : place09.lsp


 Sim
sim@acadsystems.com
ACAD Systems Sdn Bhd
https://www.acadsystems.com
+6019-4125950


;;;reading point on text file then place the point or pline or line on the design
;;; WITH BLOCK AND BLOCK NAME AND ROTATION ANGLE
;;IMPROVE ON THE DONUT N CIRCLE PROBLEM...
;;IMPROVE ON DATA PRINTING SPEED FILE INPUT..

(defun c:place ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py axy NNP PANG PBLOCK)



(Alert "\n Type   PLACE to run the program .....NEED TXT FILE WITH extension CSV

\n Data format as   X ,   Y   ==>  FOR POINT, LINE, PLINE , DONUT , CIRCLE  , TEXTZ
\n Data format as   X ,   Y  , ROTATION ANGLE  , BLOCK NAME  ==>  FOR BLOCK
\n OR
\n Data format as   X ,   Y  , OTHER POINT, OTHER VALUE, OTHER VALUE BUT ONLY NEED X,Y ==>  FOR
\n LINE,PLINE,CIRCEL,DONUT
\n ====================================================================== ")




(command "-osnap" "")
(COMMAND "ORTHO" "OFF")

;some initials setting
(setq numchk (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))

(setq F1 (getfiled "Input Data file in comma delimited form  :" ""  "csv" 2))
(setq $F1 (open F1 "r"))

(initget 1 "POINT LINE PLINE DONUT CIRCLE BLOCK TEXTZ")
(setq ddw (getkword "\n Enter command to proceeds - POINT , LINE  , PLINE , CIRCLE , DONUT , BLOCK, TEXTZ: >   "))
(PRINT " DDW IS ")(PRINC DDW)
;;;;SET THE , FOR SEPERATOR
(SETQ NNP 1)
(IF (= DDW "BLOCK")
  (PROGN
(SETQ NNP 3)  ;; X , Y , ROTATION ANGLE , BLOCKNAME
  )
  (IF (= DDW "TEXTZ")
(PROGN
(SETQ NNP 2)
)
(PROGN
(initget 1 "XY MOREXY")
(setq ddw2 (getkword "\n Enter THE DATA TYPE     XY    OR     MXY_MORE   : >  "))
(IF (= ddw2 "XY")
  (PROGN
(SETQ NNP 1)  ;; X , Y ONLY
  )
  (PROGN
(SETQ NNP 2)  ;; X , Y AND OTHER VALUE, OTHER VALUE ONLY
  )
)
) ;END PROGN
  );END IF
);END DDW
(PRINT " DDW2 IS ")(PRINC DDW2)
(PRINT " NNP IS ")(PRINC NNP) (PRINC "\n ")
;first data line
(setq nnumber 1 DATALIST NIL)
(setq BLINE1 (read-line $F1))

(while (/= BLINE1 nil)
(prin1 nnumber)(print bline1)
(setq nnumber (+ nnumber 1))


;FIND @ FIRST
;SAMPLE
;  X      Y ROTATION ANGLE   BLOCK NAME
;-5299 3721 0 left
;-5299 3654 90 left
;-5299 3587 90 left
;-5299 3118 180 left


(setq IRSSLIST NIL)
(setq KKTAB  "," BLNUM 1 IRNUM 1)     ;XXXXX SET THE SEPERATOR
(setq lent (strlen bline1))
;(print lent)
(setq ktab 0)
  (WHILE (/= (setq IRCHAR (SUBSTR BLINE1 BLNUM 1)) "")
   ; (prin1 irchar)
          (IF (= KKTAB IRCHAR)
  (PROGN
(setq IRTEMP (SUBSTR BLINE1 IRNUM (- BLNUM IRNUM)))
(setq  BLNUM (+ BLNUM 1)  IRNUM BLNUM)
;(print "NEXT  IRTEMP ARE : " ) (PRINC IRTEMP)
(setq IRSSLIST (APPEND IRSSLIST (LIST IRTEMP))); (PRINC "  AAAA")
(setq ktab (+ ktab 1))
(if (= ktab NNP)  ;;;;XXXXXX change  according to num of comma to read 6 mean 6 comma
 (setq IRSSLIST (APPEND IRSSLIST (LIST (substr bline1 blnum))))
)
           )
                    (setq BLNUM (+ BLNUM 1))
   )
          );END WHILE

;COMPLETED GETTING THE LIST
;(print "IRSSLIST ARE :") (PRINC IRSSLIST)
(setq DATALIST (append DATALIST (LIST IRSSLIST)))


  (setq BLINE1 (read-line $F1))
);END WHILE
(print datalist)
(CLOSE $F1)
(print "----- READ DATA FROM FILE COMPLETED -------")
(princ)

;;;;;CREATED POINT.......
(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
;(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(PRINT "aAA1")
(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PYis ") (prin1 pY)

;(print "assinging ...")
(setq axy (list px py))
(setq DATALISTp (append DATALISTp (LIST axy)))

(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA COMPLETED -------")
(print datalistp)
(setq ptslist datalistp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "PLINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "pline")
(foreach point ptslist (command point))
(command "")
(command "pedit" "L" "C" "")
(print " PLINE created ")
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "LINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "line")
(foreach point ptslist (command point))
(command "")
;(command "pedit" "L" "C" "")
(print " LINE created ")
   )
)

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

(IF (= ddw "POINT")
  (progn
; recreat POINT...
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "point" (nth numb ptslist))
(setq numb (+ numb 1))
)
(print " POINT created")
   )
)

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

(IF (= ddw "CIRCLE")
  (progn
; recreat CIRCLE.
(initget 7 )
(setq radd (getreal "\n Enter the Radius for the circle :  "))
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "circle" (nth numb ptslist) radd)
(setq numb (+ numb 1))
)
(print " CIRCLE created")
   )
)

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

(IF (= ddw "DONUT")
  (progn
; recreat DONUT...
(setvar "osmode" 0)

(initget 7 )
(setq raddS (getreal "\n Enter the DONUT SMALL DIAMETER for the circle :  "))
(initget 7)
(setq raddB (getreal "\n Enter the DONUT BIG DIAMETER for the circle   :  "))
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "DONUT" RADDS RADDB (nth numb ptslist) "")
(setq numb (+ numb 1))
)
(print " DONUT created")
   )
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;TEXT PUT HEIGHT Z  ==== X ,Y , Z

(IF (= ddw "TEXTZ")
  (progn
; CREATE TEXT Z ..
(setvar "osmode" 0)
(initget 7 )
(setq raddS (getreal "\n Enter the TEXT HEIGH FOR THE TEXT :  "))

;;;;;CREATED POINT AND INSERT TEXT......
;(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(setq THT (nth 2 PPSSLIST))
;(setq pBLOCK (nth 3 PPSSLIST))

(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PY is ") (prin1 pY)
(setq axy (list px py))
(PRINT  "TEXT HEGIHT OF Z Is ") (prin1 THT)

(prinC "assinging ...")

(COMMAND "TEXT" "M" AXY RADDS "0" THT)
(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA INSERTED BLOCK COMPLETED -------")

(print " TEXT HEIGHT Z INSERTED ")
   )
)


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




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;BLOCK  ==== X ,Y , ROTATION, BLOCKNAME

(IF (= ddw "BLOCK")
  (progn
; CREATE INSERT BLOCK..
(setvar "osmode" 0)

;;;;;CREATED POINT AND INSERT BLOCK......
;(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(setq pANG (nth 2 PPSSLIST))
(setq pBLOCK (nth 3 PPSSLIST))

(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PY is ") (prin1 pY)
(setq axy (list px py))
(PRINT  "ROTATION ANGLE Is ") (prin1 pANG)
(PRINT  "BLOCK NAME Is ") (prin1 pBLOCK)

(prinC "assinging ...")

(COMMAND "-INSERT" PBLOCK AXY "1" "1" PANG)
(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA INSERTED BLOCK COMPLETED -------")

(print " BLOCK INSERTED ")
   )
)


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

(PRINC "\n Type   PLACE to run the program .....NEED TXT FILE WITH extension CSV ")


(PRINC "\n Data format as   X ,   Y   ==>  FOR POINT, LINE, PLINE , DONUT , CIRCLE  ")
(PRINC "\n Data format as   X ,   Y  , ROTATION ANGLE  , BLOCK NAME  ==>  FOR BLOCK ")
(PRINC "\n OR  ")
(PRINC "\n Data format as   X ,   Y  , OTHER POINT, OTHER VALUE, OTHER VALUE BUT ONLY NEED X,Y ==>  FOR ")
(PRINC "\n LINE,PLINE,CIRCEL,DONUT ")
(PRINC "\n ============================================================================")

(PRINC "\n =========================================================================== ")





);end defun Place2...

(PRINC "\n Type   PLACE to run the program .....NEED TXT FILE WITH extension CSV ")


(PRINC "\n Data format as   X ,   Y   ==>  FOR POINT, LINE, PLINE , DONUT , CIRCLE  ")
(PRINC "\n Data format as   X ,   Y  , ROTATION ANGLE  , BLOCK NAME  ==>  FOR BLOCK ")
(PRINC "\n OR  ")
(PRINC "\n Data format as   X ,   Y  , OTHER POINT, OTHER VALUE, OTHER VALUE BUT ONLY NEED X,Y ==>  FOR ")
(PRINC "\n LINE,PLINE,CIRCEL,DONUT ")
(PRINC "\n ============================================================================")







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


(defun c:outxy ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py nn pz axy NNP PANG PBLOCK)



(Alert "\n Type   outxy to run the program .....NEED TXT FILE

\n Data format as   X ,   Y  , Z  ==>  FOR POINT, LINE, PLINE , DONUT , CIRCLE . TEXT
\n ====================================================================== ")


(command "-osnap" "")
(COMMAND "ORTHO" "OFF")

;some initials setting
(setq numchk (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))

;;(setq F1 (getfiled "Input Data file in comma delimited form  :" ""  "csv" 2))
(setq $F1 (open "C:/11outxy.txt" "w"))

(initget 1 "POINT LINE PLINE CIRCLE BLOCK TEXT")
(setq ddw (getkword "\n Enter object type to select or proceeds - POINT , LINE  , PLINE , CIRCLE , BLOCK, TEXT: >   "))
(PRINT " DDW IS ")(PRINC DDW)
(IF (= DDW "PLINE")
(SETQ DDW "LWPOLYLINE")
)
(IF (= DDW "BLOCK")
(SETQ DDW "INSERT")
)

(IF (= DDW "TEXTZ")
(SETQ DDW "TEXT")
)

(princ "\n Objects selected -only output the x y point of the object and place in C:/11outxy.txt file")
(setq sst (ssget (list (cons 0 ddw))))
;;(setq sst (ssget "X" (list (CONS  8 "LAYER1")(cons 0 "CIRCLE"))))

;;(COMMAND "ERASE" SST "")
(COMMAND "CHANGE" SST "" "P" "cO" "1" "")
(setq nn 0)

(while (/= (setq dd (ssname sst nn)) nil)
  (setq dd1 (entget dd))

(PRINT DD1)
(setq pxy (cdr (assoc 10 dd1)))
(IF (= DDW "LWPOLYLINE")
(setq px (car pxy) py (cadr pxy))
(setq px (car pxy) py (cadr pxy)  pz (caddr pxy))
)

(setq px (rtos px 2 4))
(setq py (rtos py 2 4))
(IF (/= DDW "LWPOLYLINE")
(setq pz (rtos pz 2 4))
)
(IF (= DDW "LWPOLYLINE")
(setq bline (strcat px " " py ))
(setq bline (strcat px " " py " " pz))
)
(write-line bline $f1)
(setq nn (+ nn 1)) (prin1 nn)
)
(close $f1)
(princ "....end...")
(princ "\n Total no of point output out is ")(prin1 (+ nn 1))
(princ "\n outout x  y point of the object and place in C:/11outxy.txt file")

(princ)
);end defun xy




















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (IF (= ddw "PL")
;   (progn
; recreat lwpolyline...
; (setvar "osmode" 0)
; (command "pline")
; (foreach point ptslist (command point))
; (command "")
; (command "pedit" "L" "C" "")
; (print " PLINE created")
;    )
; )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (IF (= ddw "POINT")
;   (progn
; recreat POINT...
; (setvar "osmode" 0)
; (command "point")
; (foreach point ptslist (command point))
; (command "")
; (command "pedit" "L" "C" "")
; (print " POINT created")
;    )
; )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;reading point on text file then place the point or pline or line on the design

(defun c:place2 ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py axy)


(command "-osnap" "")
(COMMAND "ORTHO" "OFF")

;some initials setting
(setq numchk (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))

(setq F1 (getfiled "Input Data file in comma delimited form  :" ""  "csv" 2))
(setq $F1 (open F1 "r"))

(initget 1 "POINT LINE PLINE DONUT CIRCLE")
(setq ddw (getkword "\n Enter command to proceeds - POINT , LINE  , PLINE , CIRCLE , DONUT : > "))

;first data line
(setq nnumber 1 DATALIST NIL)
(setq BLINE1 (read-line $F1))

(while (/= BLINE1 nil)
(prin1 nnumber)(print bline1)
(setq nnumber (+ nnumber 1))


;FIND @ FIRST
;SAMPLE
;Line # NETNAME DIE_PAD_NO X_COORD Y_COORD DESTINATION EDGE_OF_CHIP
;1 ___DCLK 1 -5299 3721 179 left
;2 ___NCE 2 -5299 3654 178 left
;3 ___TDI 3 -5299 3587 177 left
;11 ___L4 10 -5299 3118 172 left


(setq IRSSLIST NIL)
(setq KKTAB  "," BLNUM 1 IRNUM 1)
(setq lent (strlen bline1))
(print lent)(setq ktab 0)
  (WHILE (/= (setq IRCHAR (SUBSTR BLINE1 BLNUM 1)) "")
   ; (prin1 irchar)
          (IF (= KKTAB IRCHAR)
  (PROGN
(setq IRTEMP (SUBSTR BLINE1 IRNUM (- BLNUM IRNUM)))
(setq  BLNUM (+ BLNUM 1)  IRNUM BLNUM)
;(print "NEXT  IRTEMP ARE : " ) (PRINC IRTEMP)
(setq IRSSLIST (APPEND IRSSLIST (LIST IRTEMP))); (PRINC "  AAAA")
(setq ktab (+ ktab 1))
(if (= ktab 1)  ;;;;XXXXXX change  according to num of comma to read 6 mean 6 comma
 (setq IRSSLIST (APPEND IRSSLIST (LIST (substr bline1 blnum))))
)
           )
                    (setq BLNUM (+ BLNUM 1))
   )
          );END WHILE

;COMPLETED GETTING THE LIST
;(print "IRSSLIST ARE :") (PRINC IRSSLIST)
(setq DATALIST (append DATALIST (LIST IRSSLIST)))


  (setq BLINE1 (read-line $F1))
);END WHILE
(print datalist)
(CLOSE $F1)
(print "----- READ DATA FROM FILE COMPLETED -------")
(princ)

;;;;;CREATED POINT.......
(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
;(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
;(PRINT "aAA1")
(setq Px (atoF pX)) (PRINT "PX is ") (prin1 pX)
(setq py (atoF PY))(PRINT  "PYis ") (prin1 pY)

(prinC "assinging..")
(setq axy (list px py))
(setq DATALISTp (append DATALISTp (LIST axy)))

(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA COMPLETED -------")
(print datalistp)
(setq ptslist datalistp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "PLINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "pline")
(foreach point ptslist (command point))
(command "")
(command "pedit" "L" "C" "")
(print " PLINE created ")
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "LINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "line")
(foreach point ptslist (command point))
(command "")
;(command "pedit" "L" "C" "")
(print " LINE created ")
   )
)

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

(IF (= ddw "POINT")
  (progn
; recreat POINT...
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "point" (nth numb ptslist))
(setq numb (+ numb 1))
)
(print " POINT created")
   )
)

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

(IF (= ddw "CIRCLE")
  (progn
; recreat CIRCLE.
(initget 7)
(setq radd (getreal "\n Enter the Radius for the circle   "))
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "circle" (nth numb ptslist) radd)
(setq numb (+ numb 1))
)
(print " CIRCLE created")
   )
)

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

(IF (= ddw "DONUT")
  (progn
; recreat DONUT...
(setvar "osmode" 0)

(initget 7)
(setq raddS (getreal "\n Enter the DONUT SMALL DIAMETER for the circle  "))
(initget 7)
(setq raddB (getreal "\n Enter the DONUT BIG DIAMETER for the circle    "))
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "DONUT" RADDS RADDB (nth numb ptslist) "")
(setq numb (+ numb 1))
)
(print " DONUT created")
   )
)

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

);end defun Place...




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


(defun c:3dl ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py nn pz axy NNP PANG PBLOCK)


(Alert "\n Type   3dlline to run the program ....

\n ====================================================================== ")


(command "-osnap" "")
(COMMAND "ORTHO" "OFF")


(initget 1 "TEXTZ")
(setq ddw "TEXTZ")

(PRINT " DDW IS ")(PRINC DDW)
(SETQ NN 0)
(while (/= DDW nil)
(princ "\n Objects selected -1 TEXT IN THE DRAWING IN SEQUENCE ")
(setq sst (ENTSEL))
(setq dd1 (ENTGET (CAR SST)))
(PRINT DD1)
(SETQ PZ (CDR (ASSOC 1 DD1)))
(setq pxy (cdr (assoc 10 dd1)))
(setq px (car pxy) py (cadr pxy) )
;(setq px (rtos px 2 4))
(setq pZ (ATOF PZ))
(SETQ P1 (LIST PX PY PZ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\n Objects selected -2 TEXT IN THE DRAWING IN SEQUENCE ")
(setq sst (ENTSEL))
(setq dd1 (ENTGET (CAR SST)))
(PRINT DD1)
(SETQ PZ (CDR (ASSOC 1 DD1)))
(setq pxy (cdr (assoc 10 dd1)))
(setq px (car pxy) py (cadr pxy) )
;(setq px (rtos px 2 4))
(setq pZ (ATOF PZ))
(SETQ P2 (LIST PX PY PZ))
(COMMAND "LINE" P1 P2 "")


(setq nn (+ nn 1)) (prin1 nn)
)

(princ)
);end defun 3DL



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


(defun c:3l ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py nn pz axy NNP PANG PBLOCK)


(Alert "\n Type   3L TO DRAW 3dline to run the program ....

\n ====================================================================== ")


(command "-osnap" "")
(COMMAND "ORTHO" "OFF")


;some initials setting
(setq numchk (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))


(initget 1 "TEXTZ")
(setq ddw "TEXTZ")

(PRINT " DDW IS ")(PRINC DDW)
(SETQ NN 0)
(while (/= DDW nil)
;(princ "\n Objects selected -1 TEXT IN THE DRAWING IN SEQUENCE ")
;(setq sst (ENTSEL))
(SETQ AA "A")
(WHILE (= AA "A")
(princ "\n Select first  TEXT IN THE DRAWING IN SEQUENCE ")
(setq sst (ENTSEL))
(setq dd1 (ENTGET (CAR SST)))
(PRINT DD1)
(SETQ PT (CDR (ASSOC 0 DD1)))
(IF (= PT "TEXT")
  (PROGN
(PRINC "\n selected text..")
(SETQ AA "b")
  )
  (PROGN
(PRINC "\n no text  selected..")
(SETQ AA "A")
  )
)
)
(SETQ PZ (CDR (ASSOC 1 DD1)))
(setq pxy (cdr (assoc 10 dd1)))
(setq px (car pxy) py (cadr pxy) )
;(setq px (rtos px 2 4))
(setq pZ (ATOF PZ))
(SETQ P1 (LIST PX PY PZ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(SETQ AA "A")
(WHILE (= AA "A")
(princ "\n Objects selected -Second TEXT IN THE DRAWING : ")
(setq sst (ENTSEL))
(setq dd1 (ENTGET (CAR SST)))
(PRINT DD1)
(SETQ PT (CDR (ASSOC 0 DD1)))
(IF (= PT "TEXT")
  (PROGN
(PRINC "\n selected text..")
(SETQ AA "b")
  )
  (PROGN
(PRINC "\n no text  selected..")
(SETQ AA "A")
  )
)
)

(SETQ PZ (CDR (ASSOC 1 DD1)))
(setq pxy (cdr (assoc 10 dd1)))
(setq px (car pxy) py (cadr pxy) )
;(setq px (rtos px 2 4))
(setq pZ (ATOF PZ))
(SETQ P2 (LIST PX PY PZ))
(COMMAND "LINE" P1 P2 "")


(setq nn (+ nn 1)) (prin1 nn)
)

(princ)
);end defun 3L

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








;;;reading point and text on the text file then place text to the design drawing
;;IMPROVE ON DATA PRINTING SPEED FILE INPUT..

(defun c:placetext ( / bline1 nnumber lent ktab  f1 $f1 kktab irchar irnum blnum
numchk datalist irsslist ddw datalistp ptlist px py axy NNP PANG PBLOCK)



(Alert "\n Type   PLACETEXT to run the program .....NEED TXT FILE WITH extension CSV

\n Data format as   X ,   Y   , TEXT
\n  Make sure SET the TExt style with the height is not set to zero
\n
\n
\n
\n ====================================================================== ")




(command "-osnap" "")
(COMMAND "ORTHO" "OFF")

;some initials setting
(setq numchk (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))

(setq F1 (getfiled "Input Data file in comma delimited form  :" ""  "csv" 2))
(setq $F1 (open F1 "r"))

(initget 1 "POINT LINE PLINE DONUT CIRCLE BLOCK TEXTZ")
(setq ddw "BLOCK")
(PRINT " DDW IS ")(PRINC DDW)
;;;;SET THE , FOR SEPERATOR
(SETQ NNP 1)
(IF (= DDW "BLOCK")
  (PROGN
(SETQ NNP 2)  ;; X , Y N TEXT
  )
  (IF (= DDW "TEXTZ")
(PROGN
(SETQ NNP 2)
)
(PROGN
(initget 1 "XY MOREXY")
(setq ddw2 (getkword "\n Enter THE DATA TYPE     XY    OR     MXY_MORE   : >  "))
(IF (= ddw2 "XY")
  (PROGN
(SETQ NNP 1)  ;; X , Y ONLY
  )
  (PROGN
(SETQ NNP 2)  ;; X , Y AND OTHER VALUE, OTHER VALUE ONLY
  )
)
) ;END PROGN
  );END IF
);END DDW
(PRINT " DDW2 IS ")(PRINC DDW2)
(PRINT " NNP IS ")(PRINC NNP) (PRINC "\n ")
;first data line
(setq nnumber 1 DATALIST NIL)
(setq BLINE1 (read-line $F1))

(while (/= BLINE1 nil)
(prin1 nnumber)(print bline1)
(setq nnumber (+ nnumber 1))


(setq IRSSLIST NIL)
(setq KKTAB  "," BLNUM 1 IRNUM 1)     ;XXXXX SET THE SEPERATOR
(setq lent (strlen bline1))
;(print lent)
(setq ktab 0)
  (WHILE (/= (setq IRCHAR (SUBSTR BLINE1 BLNUM 1)) "")
   ; (prin1 irchar)
          (IF (= KKTAB IRCHAR)
  (PROGN
(setq IRTEMP (SUBSTR BLINE1 IRNUM (- BLNUM IRNUM)))
(setq  BLNUM (+ BLNUM 1)  IRNUM BLNUM)
;(print "NEXT  IRTEMP ARE : " ) (PRINC IRTEMP)
(setq IRSSLIST (APPEND IRSSLIST (LIST IRTEMP))); (PRINC "  AAAA")
(setq ktab (+ ktab 1))
(if (= ktab NNP)  ;;;;XXXXXX change  according to num of comma to read 6 mean 6 comma
 (setq IRSSLIST (APPEND IRSSLIST (LIST (substr bline1 blnum))))
)
           )
                    (setq BLNUM (+ BLNUM 1))
   )
          );END WHILE

;COMPLETED GETTING THE LIST
;(print "IRSSLIST ARE :") (PRINC IRSSLIST)
(setq DATALIST (append DATALIST (LIST IRSSLIST)))


  (setq BLINE1 (read-line $F1))
);END WHILE
(print datalist)
(CLOSE $F1)
(print "----- READ DATA FROM FILE COMPLETED -------")
(princ)

;;;;;CREATED POINT.......
(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
;(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(PRINT "aAA1")
(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PYis ") (prin1 pY)

;(print "assinging ...")
(setq axy (list px py))
(setq DATALISTp (append DATALISTp (LIST axy)))

(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA COMPLETED -------")
(print datalistp)
(setq ptslist datalistp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "PLINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "pline")
(foreach point ptslist (command point))
(command "")
(command "pedit" "L" "C" "")
(print " PLINE created ")
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (= ddw "LINE")
  (progn
; recreat lwpolyline...
(setvar "osmode" 0)
(command "line")
(foreach point ptslist (command point))
(command "")
;(command "pedit" "L" "C" "")
(print " LINE created ")
   )
)

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

(IF (= ddw "POINT")
  (progn
; recreat POINT...
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "point" (nth numb ptslist))
(setq numb (+ numb 1))
)
(print " POINT created")
   )
)

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

(IF (= ddw "CIRCLE")
  (progn
; recreat CIRCLE.
(initget 7 )
(setq radd (getreal "\n Enter the Radius for the circle :  "))
(setvar "osmode" 0)
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "circle" (nth numb ptslist) radd)
(setq numb (+ numb 1))
)
(print " CIRCLE created")
   )
)

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

(IF (= ddw "DONUT")
  (progn
; recreat DONUT...
(setvar "osmode" 0)

(initget 7 )
(setq raddS (getreal "\n Enter the DONUT SMALL DIAMETER for the circle :  "))
(initget 7)
(setq raddB (getreal "\n Enter the DONUT BIG DIAMETER for the circle   :  "))
(setq numb 0)
(while (/= (nth numb ptslist) nil)
(command "DONUT" RADDS RADDB (nth numb ptslist) "")
(setq numb (+ numb 1))
)
(print " DONUT created")
   )
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;TEXT PUT HEIGHT Z  ==== X ,Y , Z

(IF (= ddw "TEXTZ")
  (progn
; CREATE TEXT Z ..
(setvar "osmode" 0)
(initget 7 )
(setq raddS (getreal "\n Enter the TEXT HEIGH FOR THE TEXT :  "))

;;;;;CREATED POINT AND INSERT TEXT......
;(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(setq THT (nth 2 PPSSLIST))
;(setq pBLOCK (nth 3 PPSSLIST))

(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PY is ") (prin1 pY)
(setq axy (list px py))
(PRINT  "TEXT HEGIHT OF Z Is ") (prin1 THT)

(prinC "assinging ...")

(COMMAND "TEXT" "M" AXY RADDS "0" THT)
(setq numb (+ numb 1))
) ;end while
(print "----- completed DATA INSERTED BLOCK COMPLETED -------")

(print " TEXT HEIGHT Z INSERTED ")
   )
)


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




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;BLOCK  ==== X ,Y , text
(IF (= ddw "BLOCK")
  (progn
; CREATE INSERT BLOCK..
(setvar "osmode" 0)

;;;;;CREATED POINT AND INSERT BLOCK......
;(SETQ DATALISTP NIL )
(setq numb 0)
(while (/= (nth numb DATAlist) nil)
(setq ppsslist (nth numb DATALIST))
(print ppsslist)
(setq pX (nth 0 ppsslist))
(setq pY (nth 1 PPSSLIST))
(setq pANGTEXT (nth 2 PPSSLIST))
;(setq pBLOCK (nth 3 PPSSLIST))

(setq Px (atoF pX)) ;(PRINT "PX is ") (prin1 pX)
(setq py (atoF PY)) ;(PRINT "PY is ") (prin1 pY)
(setq axy (list px py))
(PRINT  "TEXT is ") (prin1 pANGtext)
;(PRINT  "BLOCK NAME Is ") (prin1 pBLOCK)

(prinC "assinging ...")

(COMMAND "text" AXY "0" PANGtext)
(setq numb (+ numb 1))
) ;end while
(print "----- completed TEXT DATA INSERTED  -------")

(print " TEXT INSERTED ")
   )
)


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

(PRINC "\n Type   PLACETEXT to run the program .....NEED TXT FILE WITH extension CSV ")


(PRINC "\n Data format as   X ,   Y  , TEXT   ")
(PRINC "\n ============================================================================")

(PRINC "\n =========================================================================== ")





);end defun Placetext...

(PRINC "\n Type   PLACETEXT to run the program .....NEED TXT FILE WITH extension CSV ")


(PRINC "\n Data format as   X ,   Y  , TEXT  ==>  FOR POINT x y then text  ")






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





No comments:

Post a Comment

ACADSYS BONUS TOOLS 2025 for AutoCAD 2025 and AutoCAD LT 2025 only version 2025.99.03 (25-11-2024)

  This is the add-on AutoLISP routine for  AutoCAD 2025 and LT2025 above, a  collection of design tools can be found here. Enjoy. ACADSYS Bo...