Command included makehatch and savehatch.
Lisp file was modified to make it works...but run slower..
hatchmaker lisp file
'Note : The pat file created need to be placed in support path of Autocad or LT folder in order to used the pattern created.
Drawing file that used the pattern created if open in other Autocad or LT will prompted missing pattern if the pattern file not copy to the Autocad systems folder.
Enjoy
Sim
sim@acadsystems.com
ACAD Systems Sdn Bhd
https://www.acadsystems.com
+6019-4125950
Collection of Autolisp programs and AutoCAD menu customization tools tips and tricks
Wednesday, 10 July 2013
Sunday, 7 July 2013
LT menu customization 15.6
This is special for LT AutoCAD user version 15.6
lt menu 15.6
Support most LT version.
Movie on setup : setup
Movie on ltmenu command : ltmenu-movie
Movie on LtStair command : LTStair-movie
Movie on LT text command : lt-text-movie
Enjoy.
Sim
Sim@acadsystems.com
https://acadsystems.com
lt menu 15.6
Support most LT version.
Movie on setup : setup
Movie on ltmenu command : ltmenu-movie
Movie on LtStair command : LTStair-movie
Movie on LT text command : lt-text-movie
Enjoy.
Sim
Sim@acadsystems.com
https://acadsystems.com
Conversion table program and text editor program
Conversion table program : conversion table
Win32pad editor :win32pad better then notepad editor
Lisp formatter :lisp formatter format lisp programming in organize structure way.
Enjoy.
Sim
+6019-4125950
Sim@acadsystems.com
https://acadsystems.com
Win32pad editor :win32pad better then notepad editor
Lisp formatter :lisp formatter format lisp programming in organize structure way.
Enjoy.
Sim
+6019-4125950
Sim@acadsystems.com
https://acadsystems.com
Thursday, 4 July 2013
TESTNG link wbl.lsp
This lisp program will export and create each layer an independent drawing. wbl
Sim
sim@acadsystems.com
ACAD Systems Sdn Bhd
https://acadsystems.com
+6019-4125950
Sim
sim@acadsystems.com
ACAD Systems Sdn Bhd
https://acadsystems.com
+6019-4125950
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 ")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 ")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Flatten in Autocad shorcut
;Create a text file using notepad called flatten.lsp
(defun C:FLATTEN ()
(command "_.UCS" "")
(command "_.move" "_all" "" '(0 0 1e99) ""
"_.move" "_p" "" '(0 0 -1e99) "")
(princ)
)
;This lisp will project or move all the Z coordinate of the objects to z =0.
; or put in icon or pull down menu.
[Flatten ]^c^cucs;;move;all;;0,0,1e99;;move;p;0,0,-1e99;;
(defun C:FLATTEN ()
(command "_.UCS" "")
(command "_.move" "_all" "" '(0 0 1e99) ""
"_.move" "_p" "" '(0 0 -1e99) "")
(princ)
)
;This lisp will project or move all the Z coordinate of the objects to z =0.
; or put in icon or pull down menu.
[Flatten ]^c^cucs;;move;all;;0,0,1e99;;move;p;0,0,-1e99;;
Subscribe to:
Posts (Atom)
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...
-
This is a special menu for AutoCAD (and AutoCAD LT 2024 only) users that allows them to place a continuing number, a trace boundary, the are...
-
Importing Points from Excel to AutoCAD/LT Using a SCRIPT File How can I input X and Y coordinates into AutoCAD and create a SCRIPT file to p...
-
Command included makehatch and savehatch. Lisp file was modified to make it works...but run slower.. hatchmaker lisp file 'Note : ...
